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

Построение фигуры через AutoLISP · 17.02.2008, 18:22

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

Рyslan · 12.05.2009, 20:08

через Command сделай, обычными отрезками или полилинией

skkkk · 12.05.2009, 20:11

Но тогда мне придется указывать точки вручную? Это нежелательно

Рyslan · 12.05.2009, 20:12

почему вручную. можно с помощью мышки. только привязаться нужно будет
только наверное нада будет размеры прямоугольника задавать через ком строку и точку привязки

skkkk · 12.05.2009, 20:29

Так ведь у меня цель - нарисовать окно в три касания (кнопка с макросом, первая точка, вторая точка). А так это уже совсем не три будет. Как программно дальше обработать эту злосчастную линию, я догадываюсь, а вот программно ее начертить....

Кулик Алексей aka kpblc · 12.05.2009, 20:33

Извини, конечно, но дин.блок чем тебе не нравится?
А так, если без особых проверок и изысков, то

Код:

[Выделить все]

(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

skkkk · 12.05.2009, 20:55

С дин.блоком четыре касания выходит минимум

. И не выходит у меня дин блок сделать, чтоб прямоугольник растягивался сразу и по Х и по У. Знаю, надо поглубже покопать.
За код спасибо большое. Супер! Только вот хотелось бы, чтоб он делал прямую, соединяющую именно середины коротких сторон,а во втором случае - именно середины длинных, а не вертикальную или горизонтальную линию чертил.

Можно так?

Кулик Алексей aka kpblc · 12.05.2009, 21:04

Чего-чего? Я специально делал, чтоб для прямоугольника повернутого под любым углом рисовался отрезок, соединяющий середины длинных (функция (test1)) или коротких (функция (test2)) сторон. Если прямоугольник имеет стороны, повернутые вертикально и горизонтально, то эти отрезки и будут располагаться вертикально и горизонтально.
Или показывай образец, где результат неверный.

skkkk · 12.05.2009, 21:25

Оба прямоугольника обработаны функцией (test1)

Кулик Алексей aka kpblc · 12.05.2009, 21:48

Понятно, надо будет еще и проверку расстояний делать

Ладно, сейчас...

Рyslan · 12.05.2009, 22:01

может сделаете склад лиспов на форуме? а то искать их по темам...

Кулик Алексей aka kpblc · 12.05.2009, 22:02

Р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

Рyslan · 12.05.2009, 22:08

ну все равно, сколько уже этих программ ты создал для разных людей и целей. собрать бы это все в отдельную тему

Кулик Алексей aka kpblc · 12.05.2009, 22:21

Вот скажи, а на фига? Все равно у каждого свои задачи, свои условия применения и т.п.
Вот последний код, например, неверно будет срабатывать, если полилиния отрисована не в мировой системе координат и (или) имеет уровень (elevation) не равным 0. Он не будет обрабатывать полилинии, лежащие внутри блоков. Он попытается сработать на любой замкнутой полилинии, если у нее 4 вершины (но при этом не отслеживается ни совпадение вершин, ни углы между ними). То есть код "на 5 минут и кружку кофе"

Рyslan · 12.05.2009, 22:29

ну как хотите

Кулик Алексей aka kpblc · 12.05.2009, 22:34

Рyslan, лично я свои без малого 16 000 сообщений даже просто физически отфильтровать не могу

Коды VVA намного более "юзабельны", но попробуй - найди их все!

E-degtyarev · 13.05.2009, 16:55

А может быть удобнее окна и двери вставлять блоками из ToolPalettes?

skkkk · 13.05.2009, 19:18

Дай Бог тебе здоровья, Алексей! Все отлично работает. Я добился-таки своего, теперь три клика оставляют после себя окно или дверь. Я скрестил твой лисп с парочкой других макросом и балдею

.
А насчет Tool Pallettes ничего сказать не могу - не пользуюсь, но сомневаюсь, что в три клика они справятся:-). Но надо попробовать - люблю всё новое.

valentin81 · 02.09.2011, 17:27

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

.
А насчет Tool Pallettes ничего сказать не могу - не пользуюсь, но сомневаюсь, что в три клика они справятся:-). Но надо попробовать - люблю всё новое.[/QUO

Всем привет! Есть ли что с AutoLISP дружит. Надо чертежик не сложный отобразить в программе. Помогите плиз

gomer · 02.09.2011, 18:38

E-degtyarev · 03.09.2011, 09:28

Цитата:

Сообщение от valentin81

А насчет Tool Pallettes ничего сказать не могу - не пользуюсь, но сомневаюсь, что в три клика они справятся:-). Но надо попробовать - люблю всё новое.

Tool Pallettes справляются аж за 2 клика!

17.02.2008, 18:22
Построение фигуры через AutoLISP severnet Регистрация: 17.02.2008 Сообщений: 5 Программно реализовать построение одного из условных обозначений в среде AutoCAD с помощью языка AutoLISP (VisualLISP). Ввод входных данных организовать через командную строку AutoCAD, предусмотреть проверку вводимых данных на допустимость. Подскажите пожалуйста, как это сделать? Очень срочно!
Просмотров: 13550