Построение фигуры через AutoLISP
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Построение фигуры через AutoLISP

Построение фигуры через AutoLISP

Ответ
Поиск в этой теме
Непрочитано 17.02.2008, 18:22 #1
Построение фигуры через AutoLISP
severnet
 
Регистрация: 17.02.2008
Сообщений: 5

Программно реализовать построение одного из условных обозначений в среде AutoCAD с помощью языка AutoLISP (VisualLISP). Ввод входных данных организовать через командную строку AutoCAD, предусмотреть проверку вводимых данных на допустимость. Подскажите пожалуйста, как это сделать? Очень срочно!
Просмотров: 13728
 
Непрочитано 17.02.2008, 18:40
#2
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,626


Это курсовая работа по программированию?
Profan вне форума  
 
Автор темы   Непрочитано 17.02.2008, 18:43
#3
severnet


 
Регистрация: 17.02.2008
Сообщений: 5


Нет, лабораторная.
severnet вне форума  
 
Непрочитано 17.02.2008, 19:15
#4
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,626


Ну, если условное обозначение представляет собой круг, то это не трудно. А какие параметры и как придется задавать в командной строке для одного из условных обозначений, к примеру, слаботочных систем? Без картинки или слайда не обойтись.
Profan вне форума  
 
Непрочитано 17.02.2008, 19:43
#5
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,626


Вот здесь:
http://www.caduser.ru/cgi-bin/f1/board.cgi?t=40671vh
под своим ФИ я высказал еще некоторые свои соображения.
Profan вне форума  
 
Автор темы   Непрочитано 17.02.2008, 20:25
#6
severnet


 
Регистрация: 17.02.2008
Сообщений: 5


Любой из этого списка:
[IMG]http://img230.**********.us/img230/3639/autocadof7.jpg[/IMG]
severnet вне форума  
 
Автор темы   Непрочитано 17.02.2008, 20:26
#7
severnet


 
Регистрация: 17.02.2008
Сообщений: 5


Не понятно, как это реализовать через командную строку. Рисуется это просто.
severnet вне форума  
 
Непрочитано 17.02.2008, 21:04
#8
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,626


Цитата:
Не понятно, как это реализовать через командную строку. Рисуется это просто.
Вот именно. Дурацкая какая-то лабораторная. Видимо, для того, чтобы не придумывать абстрактную фигуру для лабораторной, и было решено использовать какой-либо символ. Однако, тут голову сломаешь не на собственно программировании, а на сочинении запросов в командной строке. Теперь представим себе, что программа попадет в руки к кому-нибудь другому, а он не имеет картинки. Кандрашка хватит. На фиг нужна такая программа в реальной жизни? Может, тут нужно расписать какие-то общие принципы?
Profan вне форума  
 
Автор темы   Непрочитано 17.02.2008, 21:16
#9
severnet


 
Регистрация: 17.02.2008
Сообщений: 5


Если я преподу это скажу, она меня не поймет. Ну что ж.. приду с тортиком тогда.
severnet вне форума  
 
Непрочитано 17.02.2008, 21:33
#10
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,626


Сделай уж тогда программу с диалоговым окном. На слайде графически указать параметры, а в полях задавать числовые значения этих параметров. Это была бы жизненная задача.
В принципе, для любого из этих условных обозначений можно сделать программу с одним единственным запросом:
Код:
[Выделить все]
 
"Укажите точку вставки: "
Profan вне форума  
 
Непрочитано 17.02.2008, 22:32
#11
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Код:
[Выделить все]
(defun c:fig1 (/ pt)
  (vl-load-com)
  (if (= (type (setq pt
                      (vl-catch-all-apply '(lambda () (getpoint "\nЦентр <Отмена> : ")))
                     ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
    (progn
      (entmakex (list (cons 0 "CIRCLE") (cons 10 pt) (cons 40 5.)))
      (entmakex (list '(0 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                      '(90 . 4)
                      '(70 . 0)
                      '(43 . 0.0)
                      '(38 . 0.0)
                      '(39 . 0.0)
                      (cons 10 (polar pt (* pi 0.5) 5.))
                      (cons 10 (polar pt (* pi 0.25) (* 5. (sqrt 2.))))
                      (cons 10 (polar pt (* pi 1.25) (* 5. (sqrt 2.))))
                      (cons 10 (polar pt (* pi 1.5) 5.))
                      ) ;_ end of list
                ) ;_ end of entmakex
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 17.02.2008, 22:40
#12
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


Цитата:
Сообщение от Profan Посмотреть сообщение
Сделай уж тогда программу с диалоговым окном. На слайде графически указать параметры, а в полях задавать числовые значения этих параметров. Это была бы жизненная задача.
В принципе, для любого из этих условных обозначений можно сделать программу с одним единственным запросом:
Код:
[Выделить все]
 
"Укажите точку вставки: "
ГЫЫЫЫ
Хорошая програмка
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Непрочитано 17.02.2008, 22:47
#13
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,626


Так Алексей и сделал такую программу. Поскольку это условные обозначения, а не параметрические изделия, то размеры их известны. А раз так, то и отрисовать их можно программно без всяких дополнительных запросов. А в лабораторной, как я понял, должны следовать какие-то запросы в командной строке.
Profan вне форума  
 
Непрочитано 17.02.2008, 22:57
#14
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Ха, у меня тоже есть запрос. Центра окружности
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 17.02.2008, 23:00
#15
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,626


Так хоть бы спросил для приличия диаметр круга.
Profan вне форума  
 
Непрочитано 17.02.2008, 23:24
#16
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Profan, и не подумаю. Пример есть, числа все видны - кто хочет тот добьется.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 31.03.2009, 18:57
#17
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Подскажите, пожалуйста, как можно оптимизировать процесс отрисовки окон и дверей?(см. вложение). Я рисую их что называется "примитивно", много времени отнимает при таком количестве. Хотелось бы так: ввожу команду1, указываю две точки (как в _rectang - в чертеже красным), а желтые линии появляются автоматически. Для окон я использую офсет в обе стороны с удалением исходника:

Код:
[Выделить все]
;;Multi OFFset to 2 side ( http://www.caduser.ru/cgi-bin/f1/board.cgi?t=31318fs&page=2)
(defun C:MOFF2 (/ d obj ent adoc *error* DelObjList ss)
  (defun *error* (msg)(princ msg)(vla-endundomark adoc))
  (vl-load-com)(setvar "CMDECHO" 0)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ;_ end of setq
  (if (null *OFF2*)(setq *OFF2* (abs (getvar "OFFSETDIST")))) ;_ end of if
  (if (zerop *OFF2*)(setq *OFF2* 1)) ;_ end of if
  (setq d (getvar "UNDOCTL"))
  (cond ((= d 0) (vl-cmdf "_.UNDO" "_All"))
        ((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
        (t nil)
  ) ;_ end of cond
  (setq d nil) (vla-startundomark adoc)
  (while (not (numberp d))
    (princ
      (strcat "\n (Слой: "
              (if *OFFLAY*
                "Текущий)"
                "Объект)"
              ) ;_ end of if
              " Величина смещения или слой объектов [Объект/Текущий] <"
      ) ;_ end of strcat
    ) ;_ end of princ
    (princ *OFF2*)(princ ">: ")
    (initget 6 "Текущий Объект Current Object _Current Object Current Object") ;_ end of initget
    (if (null (setq d (getdist)))(setq d *OFF2*)) ;_ end of if
    (cond ((= d "Object") (setq *OFFLAY* nil)) ;_Слой объекта
          ((= d "Current") (setq *OFFLAY* t)) ;_Слой текущий
          (t nil)
    ) ;_ end of cond
  ) ;_ end of while
  (setq *OFF2* d) ;_ end of setq
  (while (setq ss nil
               ss (ssget "_:L")
         ) ;_ end of setq
    (setq d '-1)
    (while (setq obj (ssname ss (setq d (1+ d))))
      (setq ent (vlax-ename->vla-object obj))
      (cond
        ((and (vlax-write-enabled-p ent)
              (vlax-method-applicable-p ent 'Offset)
         ) ;_ end of and
         (setq
           obj (append
                 (vlax-safearray->list
                   (vlax-variant-value (vla-offset ent *OFF2*))
                 ) ;_ end of vlax-safearray->list
                 (vlax-safearray->list
                   (vlax-variant-value (vla-offset ent (- 0 *OFF2*)))
                 ) ;_ end of vlax-safearray->list
               ) ;_ end of append
         ) ;_ end of setq
         (if *OFFLAY*
           (mapcar '(lambda (x) (vla-put-layer x (getvar "CLAYER")))
                   obj
           ) ;_ end of mapcar
         ) ;_ end of if
         (setq DelObjList (cons ent DelObjList))
        )
        (t (princ "\nНе удается создать объект, подобный данному: ")
           (princ (cdr(assoc 0(entget obj))))
         )
      ) ;_ end of cond
    ) ;_ end of while
  ) ;_ end of while
  (initget "Да Нет Yes No _Yes No Yes No")
  (if (= (getkword "\nУдалять исходные объекты? [Да/Нет] <Нет> : ")
         "Yes"
      ) ;_ end of =
    (mapcar '(lambda (x)
               (if (vlax-write-enabled-p x)
                 (vla-erase x)
               ) ;_ end of if
             ) ;_ end of lambda
            DelObjList
    ) ;_ end of mapcar
  ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
) ;_ end of defun
(princ "\nНаберите в командной строке MOFF2")
Может, довески к КАДу какие есть...С меня требуют именно по такому шаблону
Вложения
Тип файла: dwg
DWG 2007
Чертеж1.dwg (62.3 Кб, 2332 просмотров)

Последний раз редактировалось skkkk, 31.03.2009 в 19:03.
skkkk вне форума  
 
Непрочитано 12.05.2009, 18:33
#18
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Возможно ли в принципе построение лиспом на прямоугольнике линии, соединяющей центры коротких или длинных сторон (отдельно)? Не знаю, как начать думать, чтоб до этого додуматься, но нутром чую, что можно.
Помогите, пожалуйста, кто знает
skkkk вне форума  
 
Непрочитано 12.05.2009, 19:16
#19
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,518


тебе сразу прямоугольник нужно нарисовать с перкрестием внутри или на приямоугольник нанести перекрестие?
Рyslan вне форума  
 
Непрочитано 12.05.2009, 19:55
#20
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Нет, нужно два варианта: один прямая параллельна длинным сторонам и соединяет середины коротких, а второй - наоборот. (См. вложение в #17)
skkkk вне форума  
 
Непрочитано 12.05.2009, 20:08
#21
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,518


через Command сделай, обычными отрезками или полилинией
Рyslan вне форума  
 
Непрочитано 12.05.2009, 20:11
#22
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Но тогда мне придется указывать точки вручную? Это нежелательно
skkkk вне форума  
 
Непрочитано 12.05.2009, 20:12
#23
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,518


почему вручную. можно с помощью мышки. только привязаться нужно будет
только наверное нада будет размеры прямоугольника задавать через ком строку и точку привязки
Рyslan вне форума  
 
Непрочитано 12.05.2009, 20:29
#24
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Так ведь у меня цель - нарисовать окно в три касания (кнопка с макросом, первая точка, вторая точка). А так это уже совсем не три будет. Как программно дальше обработать эту злосчастную линию, я догадываюсь, а вот программно ее начертить....
skkkk вне форума  
 
Непрочитано 12.05.2009, 20:33
#25
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Извини, конечно, но дин.блок чем тебе не нравится?
А так, если без особых проверок и изысков, то
Код:
[Выделить все]
(defun test1 (/ adoc ent coord norm long)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (and (= (type
                (setq
                  ent (vl-catch-all-apply
                        (function
                          (lambda ()
                            (car (entsel "\nSelect a rectangle <Cancel> : "))
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
                ) ;_ end of type
              'ename
              ) ;_ end of =
           (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
           (= (cdr (assoc 90 (entget ent))) 4)
           (= (cdr (assoc 70 (entget ent))) 1)
           ) ;_ end of and
    (progn
      (setq norm  (cdr (assoc 210 (entget ent)))
            coord (mapcar
                    'cdr
                    (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
                    ) ;_ end of mapcar
            long  (entmakex
                    (list
                      (cons 0 "LINE")
                      (cons 10
                            (mapcar
                              (function
                                (lambda (a b)
                                  (* (+ a b) 0.5)
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              (car coord)
                              (cadr coord)
                              ) ;_ end of mapcar
                            ) ;_ end of cons
                      (cons 11
                            (mapcar (function
                                      (lambda (a b)
                                        (* (+ a b) 0.5)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    (last coord)
                                    (caddr coord)
                                    ) ;_ end of mapcar
                            ) ;_ end of cons
                      ) ;_ end of list
                    ) ;_ end of entmakex
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

(defun test2 (/ adoc ent coord norm long)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (and (= (type
                (setq
                  ent (vl-catch-all-apply
                        (function
                          (lambda ()
                            (car (entsel "\nSelect a rectangle <Cancel> : "))
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
                ) ;_ end of type
              'ename
              ) ;_ end of =
           (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
           (= (cdr (assoc 90 (entget ent))) 4)
           (= (cdr (assoc 70 (entget ent))) 1)
           ) ;_ end of and
    (progn
      (setq norm  (cdr (assoc 210 (entget ent)))
            coord (mapcar
                    'cdr
                    (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
                    ) ;_ end of mapcar
            long  (entmakex
                    (list
                      (cons 0 "LINE")
                      (cons 10
                            (mapcar
                              (function
                                (lambda (a b)
                                  (* (+ a b) 0.5)
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              (car coord)
                              (last coord)
                              ) ;_ end of mapcar
                            ) ;_ end of cons
                      (cons 11
                            (mapcar (function
                                      (lambda (a b)
                                        (* (+ a b) 0.5)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    (cadr coord)
                                    (caddr coord)
                                    ) ;_ end of mapcar
                            ) ;_ end of cons
                      ) ;_ end of list
                    ) ;_ end of entmakex
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.05.2009, 20:55
#26
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


С дин.блоком четыре касания выходит минимум. И не выходит у меня дин блок сделать, чтоб прямоугольник растягивался сразу и по Х и по У. Знаю, надо поглубже покопать.
За код спасибо большое. Супер! Только вот хотелось бы, чтоб он делал прямую, соединяющую именно середины коротких сторон,а во втором случае - именно середины длинных, а не вертикальную или горизонтальную линию чертил. Можно так?
skkkk вне форума  
 
Непрочитано 12.05.2009, 21:04
#27
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Чего-чего? Я специально делал, чтоб для прямоугольника повернутого под любым углом рисовался отрезок, соединяющий середины длинных (функция (test1)) или коротких (функция (test2)) сторон. Если прямоугольник имеет стороны, повернутые вертикально и горизонтально, то эти отрезки и будут располагаться вертикально и горизонтально.
Или показывай образец, где результат неверный.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.05.2009, 21:25
#28
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Оба прямоугольника обработаны функцией (test1)
Вложения
Тип файла: dwg
DWG 2007
Чертеж1.dwg (60.8 Кб, 1399 просмотров)
skkkk вне форума  
 
Непрочитано 12.05.2009, 21:48
#29
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Понятно, надо будет еще и проверку расстояний делать Ладно, сейчас...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.05.2009, 22:01
#30
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,518


может сделаете склад лиспов на форуме? а то искать их по темам...
Рyslan вне форума  
 
Непрочитано 12.05.2009, 22:02
#31
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Рyslan, по-моему, их проще научиться самому рисовать
skkkk, тестируй:
Код:
[Выделить все]
(defun c:make-long (/ adoc ent coord norm long)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (and (= (type
                (setq
                  ent (vl-catch-all-apply
                        (function
                          (lambda ()
                            (car (entsel "\nSelect a rectangle <Cancel> : "))
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
                ) ;_ end of type
              'ename
              ) ;_ end of =
           (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
           (= (cdr (assoc 90 (entget ent))) 4)
           (= (cdr (assoc 70 (entget ent))) 1)
           ) ;_ end of and
    (progn
      (setq norm  (cdr (assoc 210 (entget ent)))
            coord (mapcar
                    'cdr
                    (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
                    ) ;_ end of mapcar
            coord (vl-sort coord
                           '(lambda (a b)
                              (< (distance (car coord) a) (distance (car coord) b))
                              ) ;_ end of lambda
                           ) ;_ end of vl-sort
            long  (entmakex
                    (list
                      (cons 0 "LINE")
                      (cons 10
                            (mapcar
                              (function
                                (lambda (a b)
                                  (* (+ a b) 0.5)
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              (car coord)
                              (cadr coord)
                              ) ;_ end of mapcar
                            ) ;_ end of cons
                      (cons 11
                            (mapcar (function
                                      (lambda (a b)
                                        (* (+ a b) 0.5)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    (last coord)
                                    (caddr coord)
                                    ) ;_ end of mapcar
                            ) ;_ end of cons
                      ) ;_ end of list
                    ) ;_ end of entmakex
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

(defun c:make-short (/ adoc ent coord norm long)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (and (= (type
                (setq
                  ent (vl-catch-all-apply
                        (function
                          (lambda ()
                            (car (entsel "\nSelect a rectangle <Cancel> : "))
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                  ) ;_ end of setq
                ) ;_ end of type
              'ename
              ) ;_ end of =
           (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
           (= (cdr (assoc 90 (entget ent))) 4)
           (= (cdr (assoc 70 (entget ent))) 1)
           ) ;_ end of and
    (progn
      (setq norm  (cdr (assoc 210 (entget ent)))
            coord (mapcar
                    'cdr
                    (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
                    ) ;_ end of mapcar
            coord (vl-sort coord
                           '(lambda (a b)
                              (< (distance (car coord) a) (distance (car coord) b))
                              ) ;_ end of lambda
                           ) ;_ end of vl-sort
            long  (entmakex
                    (list
                      (cons 0 "LINE")
                      (cons 10
                            (mapcar
                              (function
                                (lambda (a b)
                                  (* (+ a b) 0.5)
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              (car coord)
                              (caddr coord)
                              ) ;_ end of mapcar
                            ) ;_ end of cons
                      (cons 11
                            (mapcar (function
                                      (lambda (a b)
                                        (* (+ a b) 0.5)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    (cadr coord)
                                    (cadddr coord)
                                    ) ;_ end of mapcar
                            ) ;_ end of cons
                      ) ;_ end of list
                    ) ;_ end of entmakex
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.05.2009, 22:08
#32
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,518


ну все равно, сколько уже этих программ ты создал для разных людей и целей. собрать бы это все в отдельную тему
Рyslan вне форума  
 
Непрочитано 12.05.2009, 22:21
#33
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Вот скажи, а на фига? Все равно у каждого свои задачи, свои условия применения и т.п.
Вот последний код, например, неверно будет срабатывать, если полилиния отрисована не в мировой системе координат и (или) имеет уровень (elevation) не равным 0. Он не будет обрабатывать полилинии, лежащие внутри блоков. Он попытается сработать на любой замкнутой полилинии, если у нее 4 вершины (но при этом не отслеживается ни совпадение вершин, ни углы между ними). То есть код "на 5 минут и кружку кофе"
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.05.2009, 22:29
#34
Рyslan


 
Регистрация: 25.07.2007
Сообщений: 2,518


ну как хотите
Рyslan вне форума  
 
Непрочитано 12.05.2009, 22:34
#35
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Рyslan, лично я свои без малого 16 000 сообщений даже просто физически отфильтровать не могу Коды VVA намного более "юзабельны", но попробуй - найди их все!
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 13.05.2009, 16:55
#36
E-degtyarev

Помогаю, кому делать нечего.
 
Регистрация: 27.03.2009
Русская деревня
Сообщений: 394


А может быть удобнее окна и двери вставлять блоками из ToolPalettes?
E-degtyarev вне форума  
 
Непрочитано 13.05.2009, 19:18
#37
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Дай Бог тебе здоровья, Алексей! Все отлично работает. Я добился-таки своего, теперь три клика оставляют после себя окно или дверь. Я скрестил твой лисп с парочкой других макросом и балдею.
А насчет Tool Pallettes ничего сказать не могу - не пользуюсь, но сомневаюсь, что в три клика они справятся:-). Но надо попробовать - люблю всё новое.
skkkk вне форума  
 
Непрочитано 02.09.2011, 17:27
#38
valentin81

Студент
 
Регистрация: 20.06.2007
Пермь ПГСХА
Сообщений: 9


[quote=skkkk;395206]Дай Бог тебе здоровья, Алексей! Все отлично работает. Я добился-таки своего, теперь три клика оставляют после себя окно или дверь. Я скрестил твой лисп с парочкой других макросом и балдею.
А насчет Tool Pallettes ничего сказать не могу - не пользуюсь, но сомневаюсь, что в три клика они справятся:-). Но надо попробовать - люблю всё новое.[/QUO

Всем привет! Есть ли что с AutoLISP дружит. Надо чертежик не сложный отобразить в программе. Помогите плиз
__________________
Люди нужен альбом Шерешевского и другие книги с узлами пром и гражданских зданий! у кого ест поделитесь
valentin81 вне форума  
 
Непрочитано 02.09.2011, 18:38
#39
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


???

Последний раз редактировалось gomer, 03.09.2011 в 13:00.
gomer вне форума  
 
Непрочитано 03.09.2011, 09:28
#40
E-degtyarev

Помогаю, кому делать нечего.
 
Регистрация: 27.03.2009
Русская деревня
Сообщений: 394


Цитата:
Сообщение от valentin81 Посмотреть сообщение
А насчет Tool Pallettes ничего сказать не могу - не пользуюсь, но сомневаюсь, что в три клика они справятся:-). Но надо попробовать - люблю всё новое.
Tool Pallettes справляются аж за 2 клика!
E-degtyarev вне форума  
 
Непрочитано 20.05.2015, 08:26
#41
tujn08


 
Регистрация: 26.12.2013
Сообщений: 283


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Если прямоугольник имеет стороны, повернутые вертикально и горизонтально
Привет!
Посмотрел код - как сделать, что бы всегда было вертикально и горизонтально.
Мне надо вставлять красную рамку(строго вертикально/горизонтально) в нужном слое (без излишков по двум точкам).
Полистаю entmake, но ответа все равно буду ждать(засиживаться на этом не хочу).
tujn08 вне форума  
 
Непрочитано 20.05.2015, 09:20
#42
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450


Чего? А как бы насчет перевода?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.05.2015, 09:40
#43
tujn08


 
Регистрация: 26.12.2013
Сообщений: 283


Программно надо рисовать замкнутый прямоугольник ("_rectang"), по координатам Х1У1 Х2У2 в новом слое (8 . "Слой1") красного цвета (67 . 1)

Вот примерно так надо (только еще вернуться в предыдущий слой):
Код:
[Выделить все]
 (progn
	(vl-load-com)
	(command "_.layer" "_M" "Форматка_рамка2" "_C" "1" "Форматка_рамка2")
	(setq nab (ssget "_X"  (list (cons 8 "Форматка_штамп") (cons 0 "INSERT")))) ; создали набор из всех форматок
	(setq b (sslength nab))
	(setq i (1- b)); количество в наборе и на чало счетчика переключения
(repeat b
			(setq a (ssname nab i)) ; взяли последний элемент в наборе
			(setq X1 (fix(cadr(assoc '10 (entget a))))) ;Y координата выбранного блока
			(setq Y1 (fix(caddr(assoc '10 (entget a))))) ;X координата выбранного блока
			(setq a4 a)
			(setq a (entnext a)) ;тут уже атрибут сидит первого примитива
				(setq blk (vlax-ename->vla-object a4))
				(setq q (mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties)))
				(setq r_X2 (cdr (assoc '"Расстояние1" q))) ;длина
				(setq r_Y2 (cdr (assoc '"Расстояние2" q))) ;высота
			(setq X2 (- X1 r_X2))
			(setq Y2 (+ Y1 r_Y2))
(setq p1 (list X1 Y1)) ;координата начало
(setq p2 (list X2 Y2)) ;координата конец
(command "_rectang" p1 p2)
(setq i (1- i))
) ;repeat b
)
----- добавлено через ~3 ч. -----
Задачу решил ...

Последний раз редактировалось tujn08, 20.05.2015 в 13:08.
tujn08 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Построение фигуры через AutoLISP

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск