Учим Автокад автоматической расстановки блоков на поверхности чертежа

[Peacemaker_kiss]

Продолжаю свою рубрику автоматизации проектирования архитектурного освещения, идея этого макроса пришла, когда на поверхности фасада, согласно светотехнической задачи требовалось расставить несколько сот светильников, которые должны стоять вплотную или совсем рядом! Это выполняет данный макрос. Который отыскивает вспомогательные блоки уровни и вычисляя их длину заполняет линейно заполняет их! Прикладываю файл с выполненным макросом. В предыдущем посте ищу помощи для создания грамотного интерактива в рамках запросов пользователей. Макрос будет претерпевать изменения и я их буду отражать. Будет приятен отклик инженеров, которые увидят дальнейшие пути модификации, отличные от моих.

Код - Auto/Visual Lisp [Выбрать]

1. (defun c:sv_lamps (/ nabor _len1 _eff_name _block _conduit quantity point counter poinsert _cond )
2.   (vl-load-com)
3.   (setq acadd (vlax-get-acad-object))
4.   (setq active_doc (vla-get-ActiveDocument acadd))
5.   (setq mspace (vla-get-ModelSpace active_doc))
6.   (setq L900 9.1)
7.   (setq L1200 13)
8.   (setq L600 6)
9.   (setq xscale 1)
10.   (setq yscale 1)
11.   (setq zscale 1)
12.   (setq rot (/ (getint "Введите угол поворота светильников на карнизах: 0; 180 ") (/ 180 pi)))
13.   (setq rot1 (/ (getint "Введите угол поворота светильников в дверных проемах: 0; 180 ") (/ 180 pi)))
14.   (setq nabor (ssget "_X" (list (cons 8 "_АХП_Вспомогательный_слой_не_печать" ) (cons 0 "insert"))))
15.       (if nabor
16.                  (progn
17.                  (princ (strcat "Найдено блоков:" (rtos (sslength nabor) 2 0) "шт."))
18.                  (terpri)
19.                    (setq name "L (900 mm)")
20.                    (setq counter 0)
21.         (while (< counter (sslength nabor))
22.                   (setq _block (vlax-ename->vla-object (ssname nabor counter)))
23.                   (setq point (cdr (assoc 10 (entget (ssname nabor counter)))))
24.                   (setq x_coord (nth 0 point))
25.                   (setq y_coord (nth 1 point))
26.                   (setq z_coord (nth 2 point))
27.                   (setq _eff_name (vla-get-effectivename _block))
28.                   (princ _eff_name)
29.                   (terpri)
30.         (if
31.           (wcmatch _eff_name "!Карниз")
32.           (progn
33.                   (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
34.           (nth 0 drop)
35.             (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
36.             (setq quantity (fix (/ _len1 L900)))
37.             (setq counter1 0)
38.             (while (< counter1 quantity)
39.               (setq x_coord` (+ x_coord (/ (+ L900 (/ (- _len1 (* quantity L900)) quantity)) 2) (* 1 counter1 (+ L900 (/ (- _len1 (* quantity L900)) quantity)))))
40.                                       (setq poinsert (vlax-3d-point x_coord` y_coord z_coord))
41.              (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot)
42.                                (setq counter1 (+ 1 counter1)))(princ "ok !Карниз")(terpri))
43.                              
44.                   (progn (setq _cond (getint "\n Выберите вариант: 1 - Один блок; 2 - Заполнить проем"))
45.           (if (= _cond 1) (progn
46.            (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
47.            (nth 0 drop)
48.            (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
49.                         (setq x_half (+ x_coord (/ _len1 2)))
50.                          (setq poinsert (vlax-3d-point  x_half y_coord z_coord))
51.                 (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot1)
52.            (princ "ok !Дверной проем")(terpri))
53.            (progn
54.              (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
55.            (nth 0 drop)
56.              (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
57.             (setq quantity (fix (/ _len1 L900)))
58.             (setq counter1 0)
59.             (while (< counter1 quantity)
60.               (setq x_coord` (+ x_coord (/ (+ L900 (/ (- _len1 (* quantity L900)) quantity)) 2) (* 1 counter1 (+ L900 (/ (- _len1 (* quantity L900)) quantity)))))
61.                 (setq poinsert (vlax-3d-point x_coord` y_coord z_coord))
62.              (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot1)
63.                                (setq counter1 (+ 1 counter1))(princ "ok !Дверной проем")(terpri))
64.             )
65.                      
66.      )))
67.     (princ counter)
68.                    (setq counter (+ 1 counter))))
69.                    (progn
70.                      (alert (princ "\nНет блоков, расположите блоки на фасаде здания"))
71. (terpri))
72.         ))
73.  
74.            

[Алексей Кулик]

Критиковать по частям или как?

[Алексей Кулик]

Пока есть время и мозги еще хоть что-то соображают...
• (vl-load-com) я бы вынес за пределы команды.
• Множество строк
  

Код - Auto/Visual Lisp [Выбрать]

1. (setq acadd (vlax-get-acad-object))
2.   (setq active_doc (vla-get-activedocument acadd))

заменить на

Код - Auto/Visual Lisp [Выбрать]

1. (setq acadd      (vlax-get-acad-object)
2.         active_doc (vla-get-activedocument acadd)
3.         )

[/li]

• Что будет, если код будет запущен в AutoCAD 2013 Eng без установленного SP?
• Что будет, если пользователь в ответ на запрос getint нажмет Esc?
• Что будет, если пользователь в ответ на запрос угла введет не 0 или 180, а 465,656989?
• Почему набор формируется по заранее определенному слою?
• Что будет, если код сдуру попытаются запустить в ACAD 2005, где понятия EffectiveName не было?
• Почему вставка производится именно в пространство модели, хотя блок карниза может запросто находиться в пространстве листа?
• Почему не используется связка initget - getkword?
• Что будет, если попадется пользователь, сделавший блок "Карниз" не динамическим?
• Где метки начала и конца отмены?

Вот как-то так примерно, по первым впечатлениям... Разбираться более подробно пока не хочу

[Peacemaker_kiss]

Спасибо за критику, буду совершенствовать! Лишь отмечу одно, темы относительно старого автокада не рассматриваю, не зачем сидеть с нокией 3310 когда можно купить недорогой iphone, отвечу метафорически примерно так....Алексей от души спасибо, для полета мыслей целое небо предоставил! Выборка по слоям сделал, потому что так нам удобней вводить в чертеж элементы которые не идут на печать, да и блоки найти намного легче (я посмотрел как все ищут динамические блоки, длинновато), мы работаем только в пространстве модели, а листы существуют лишь для печати, отсюда ответ на критику вставки блока в тело модели. По остальному буду думать...

[Peacemaker_kiss]

Что будет, если попадется пользователь, сделавший блок "Карниз" не динамическим?

Защита от дурака - это блестяще

[Peacemaker_kiss]

Что будет, если код сдуру попытаются запустить в ACAD 2005, где понятия EffectiveName не было?

Алексей, я не меняя позиции относительно автокадов, но мой пытливый ум сгорает от любопытства, как решить мою задачу с effective name для автокад 2005

[Алексей Кулик]

Получаешь OwnerID для выбранного блока, преобразовываешь его в ObjectID (http://autolisp.ru/2014/09/16/objectid_x32x64_cad2015/ + http://autolisp.ru/2011/07/07/x32x64objectid/) - вот тебе и указатель на то, куда вставлять свои блоки.

Что будет, если код будет запущен в AutoCAD 2013 Eng без установленного SP?

Это к вопросу о кириллице в запросе. Лично я давненько уже использую такие функции:

Код - Auto/Visual Lisp [Выбрать]

1. (defun _kpblc-acad-version ()
2.                            ;|
3. *    Определение номера сборки AutoCAD
4. *    Возвращаемое значение: Число двойной точности. Для AutoCAD 2005 вернет 16.1, для 2006 - 16.2 и т.д.
5. Примеры вызова:
6. (_kpblc-acad-version)
7. |;
8.   (atof (getvar "acadver"))
9.   ) ;_ end of defun
10.  
11. (defun _kpblc-is-acad-rus ()
12.                           ;|
13. *    Проверяет, является ли AutoCAD русским. Для версий AutoCAD до 2012 включительно возвращает t
14. * независимо от локализации. В версии 2013 обрабатывает язык AutoCAD'a
15. |;
16.   (or
17.     (= (vla-get-localeid (vlax-get-acad-object)) 1049)
18.     (/= (_kpblc-acad-version) 19.)
19.     (and (= (_kpblc-acad-version) 19.)
20.          (vl-registry-descendents
21.            (strcat
22.              "HKEY_LOCAL_MACHINE\\"
23.              (vl-string-trim
24.                "\\"
25.                (car (_kpblc-conv-string-to-list (vlax-product-key) ":"))
26.                ) ;_ end of vl-string-trim
27.              "\\Service Packs"
28.              ) ;_ end of strcat
29.            ) ;_ end of vl-registry-descendents
30.          ) ;_ end of and
31.     ) ;_ end of or
32.   ) ;_ end of defun

Соответственно запрос получается наподобие

Код - Auto/Visual Lisp [Выбрать]

1. (defun test (/ res)
2.  
3.   (if (= (type (setq res (vl-catch-all-apply
4.                            (function
5.                              (lambda ()
6.                                (initget "0 180")
7.                                (getkword (strcat (if (_kpblc-is-acad-rus)
8.                                                    "Введите угол "
9.                                                    "Enter angle value "
10.                                                    ) ;_ end of if
11.                                                  "[0/180] <"
12.                                                  (if (_kpblc-is-acad-rus)
13.                                                    "Отмена"
14.                                                    "Cancel"
15.                                                    ) ;_ end of if
16.                                                  "> : "
17.                                                  ) ;_ end of strcat
18.                                          ) ;_ end of getkword
19.                                ) ;_ end of lambda
20.                              ) ;_ end of function
21.                            ) ;_ end of vl-catch-all-apply
22.                      ) ;_ end of setq
23.                ) ;_ end of type
24.          'str
25.          ) ;_ end of =
26.     (princ (strcat "res = " res))
27.     ) ;_ end of if
28.   )

темы относительно старого автокада не рассматриваю

А зря... Варианты бывают разные, сильно разные.

[Алексей Кулик]

Касаемо старых версий: проверяй доступность свойства EffectiveName. Если его нет - то пробуй получить Name.

[Peacemaker_kiss]

Про локализацию согласен, тема интересная, а про угол - не использовал initget потому что пользователю разрешается внести любой угол, а 0 и 180 - это предпочитаемые!
Спасибо за помощь
А про старые автокады не пиши "...Зря" пиши почему интересно их изучить, я у себя на работе развернул 2015 и живу хорошо, но раз указываешь, что важно приведи несколько примеров

[Алексей Кулик]

Ну, я уже написал причину Хорошо, расшифровываю: хотя бы потому, что ты не всю оставшуюся жизнь будешь работать только в сегодняшней конторе. Есть еще и халтуры Куда придешь, на какие версии и каких продуктов - тайна, не известная никому. Так что лучше соломку подстелить, благо это вопрос пары минут

[Алексей Кулик]

не использовал initget потому что пользователю разрешается внести любой угол, а 0 и 180 - это предпочитаемые

Ок, а что будет, если человеку понадобится вводить угол в 45°16'23''? А какое значение должно быть "по умолчанию" (для клика по Enter)? Может, тогда заменить getint на getangle? А заодно и продумать, от какой точки отмерять этот угол.
ПыСы. Это я еще и про нетекущую систему координат не вспоминаю Но это в 90% случаев излишне.

[Peacemaker_kiss]

Наслушавшись умных советов, добавил интерактива для пользователя, кое-какие вкусности и удобности для него же, но не сделал пока ссылки на проверки версий и.т.д. и вот почему, если обратить внимание, то у меня получилось в коде, для работы одного из условий, точное копирование куска кода, все прекрасно работает, но код не совсем эстетичен, пользователю все равно ибо работает, а вот для меня задача оказалась, странно, нерешаемой по сокращению кода. Уважаемые модераторы, считаю следует объединить эту тему и тему "Как приостановить lisp-макрос, выделить вставленные им блоки, и продолжить его.." ибо в идеале мой макрос будет полностью готовым лишь после того, как я решу все задачи, однако не настаиваю, так как могу вести темы параллельно

Код - Auto/Visual Lisp [Выбрать]

1. (vl-load-com)
2. (defun c:sv_lamps (/ nabor _len1 _eff_name _block _conduit quantity point counter poinsert _cond _lenbl x_half x_half y_coord z_coord x_coord` chname chlenbl )
3.   (setq acadd (vlax-get-acad-object))
4.   (setq active_doc (vla-get-ActiveDocument acadd))
5.   (setq mspace (vla-get-ModelSpace active_doc))
6.   (setq L300 3.1)
7.   (setq L600 6.1)
8.   (setq L900 9.1)
9.   (setq L1000 11)
10.   (setq L1200 13)
11.   (setq xscale 1)
12.   (setq yscale 1)
13.   (setq zscale 1)
14.   (setq rot (/ (getint "Введите угол поворота светильников на карнизах: 0; 180 ") (/ 180 pi)))
15.   (setq rot1 (/ (getint "Введите угол поворота светильников в дверных проемах: 0; 180 ") (/ 180 pi)))
16.   (setq nabor (ssget "_X" (list (cons 8 "_АХП_Вспомогательный_слой_не_печать" ) (cons 0 "insert"))))
17.       (if nabor
18.                  (progn
19.                  (princ (strcat "Найдено блоков:" (rtos (sslength nabor) 2 0) "шт."))
20.                  (terpri)
21.                    (initget 1 "Да Нет")
22.                     (setq cond_bl (getkword "Использовать выбранный блок для всего чертежа? [Да/Нет]: "))
23.                         (if (wcmatch cond_bl "Да") (progn
24.                                                     (setq name (getstring T "Введите имя блока светильника (см. палитру): "))
25.                                                     (setq counter 0)
26.       (while (< counter (sslength nabor))
27.         (setq _block  (vlax-ename->vla-object (ssname nabor counter)))
28.                      (setq chlenbl
29.                          (cond
30.                     ((wcmatch name "L (300 mm)") (setq _lenbl L300))
31.                     ((wcmatch name "L (600 mm)") (setq _lenbl L600))
32.                     ((wcmatch name "L (900 mm)") (setq _lenbl L900))
33.                     ((wcmatch name "L (1000 mm)") (setq _lenbl L1000))
34.                     ((wcmatch name "L (1200 mm)") (setq _lenbl L1200))))
35.                   (setq point (cdr (assoc 10 (entget (ssname nabor counter)))))
36.                   (setq x_coord (nth 0 point))
37.                   (setq y_coord (nth 1 point))
38.                   (setq z_coord (nth 2 point))
39.                   (setq _eff_name (vla-get-effectivename _block))
40.                   (princ _eff_name)
41.                   (terpri)
42.         (if
43.           (wcmatch _eff_name "!Карниз")
44.           (progn
45.                   (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
46.           (nth 0 drop)
47.             (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
48.             (setq quantity (fix (/ _len1 _lenbl)))
49.             (setq counter1 0)
50.             (while (< counter1 quantity)
51.               (setq x_coord` (+ x_coord (/ (+ _lenbl (/ (- _len1 (* quantity _lenbl)) quantity)) 2) (* 1 counter1 (+ _lenbl (/ (- _len1 (* quantity _lenbl)) quantity)))))
52.                                       (setq poinsert (vlax-3d-point x_coord` y_coord z_coord))
53.              (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot)
54.                                (setq counter1 (+ 1 counter1)))(princ "ok !Карниз")(terpri))
55.                              
56.                   (progn (setq _cond (getint "\n Выберите вариант: 1 - Один блок; 2 - Заполнить проем"))
57.           (if (= _cond 1) (progn
58.            (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
59.            (nth 0 drop)
60.            (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
61.                         (setq x_half (+ x_coord (/ _len1 2)))
62.                          (setq poinsert (vlax-3d-point  x_half y_coord z_coord))
63.                 (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot1)
64.            (princ "ok !Дверной проем")(terpri))
65.            (progn
66.              (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
67.            (nth 0 drop)
68.              (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
69.             (setq quantity (fix (/ _len1 _lenbl)))
70.             (setq counter1 0)
71.             (while (< counter1 quantity)
72.               (setq x_coord` (+ x_coord (/ (+ _lenbl (/ (- _len1 (* quantity _lenbl)) quantity)) 2) (* 1 counter1 (+ _lenbl (/ (- _len1 (* quantity _lenbl)) quantity)))))
73.                 (setq poinsert (vlax-3d-point x_coord` y_coord z_coord))
74.              (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot1)
75.                                (setq counter1 (+ 1 counter1))(princ "ok !Дверной проем")(terpri))
76.             )        
77.      )))
78.     (terpri)(princ counter)
79.                   (setq counter (+ 1 counter))(terpri)(princ "Расстановка выполнена"))
80.                                                     )
81.                                                   (progn
82.                             (setq counter 0)
83.       (while (< counter (sslength nabor))
84.         (setq _block  (vlax-ename->vla-object (ssname nabor counter)))
85.         (vla-highlight _block :vlax-true)
86.                              (setq name (getstring T "Введите имя блока светильника (см. палитру): "))
87.                      (setq chlenbl
88.                          (cond
89.                     ((wcmatch name "L (300 mm)") (setq _lenbl L300))
90.                     ((wcmatch name "L (600 mm)") (setq _lenbl L600))
91.                     ((wcmatch name "L (900 mm)") (setq _lenbl L900))
92.                     ((wcmatch name "L (1000 mm)") (setq _lenbl L1000))
93.                     ((wcmatch name "L (1200 mm)") (setq _lenbl L1200))))
94.                   (setq point (cdr (assoc 10 (entget (ssname nabor counter)))))
95.                   (setq x_coord (nth 0 point))
96.                   (setq y_coord (nth 1 point))
97.                   (setq z_coord (nth 2 point))
98.                   (setq _eff_name (vla-get-effectivename _block))
99.                   (princ _eff_name)
100.                   (terpri)
101.         (if
102.           (wcmatch _eff_name "!Карниз")
103.           (progn
104.                   (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
105.           (nth 0 drop)
106.             (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
107.             (setq quantity (fix (/ _len1 _lenbl)))
108.             (setq counter1 0)
109.             (while (< counter1 quantity)
110.               (setq x_coord` (+ x_coord (/ (+ _lenbl (/ (- _len1 (* quantity _lenbl)) quantity)) 2) (* 1 counter1 (+ _lenbl (/ (- _len1 (* quantity _lenbl)) quantity)))))
111.                                       (setq poinsert (vlax-3d-point x_coord` y_coord z_coord))
112.              (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot)
113.                                (setq counter1 (+ 1 counter1)))(princ "ok !Карниз")(terpri))
114.                              
115.                   (progn (setq _cond (getint "\n Выберите вариант: 1 - Один блок; 2 - Заполнить проем"))
116.           (if (= _cond 1) (progn
117.            (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
118.            (nth 0 drop)
119.            (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
120.                         (setq x_half (+ x_coord (/ _len1 2)))
121.                          (setq poinsert (vlax-3d-point  x_half y_coord z_coord))
122.                 (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot1)
123.            (princ "ok !Дверной проем")(terpri))
124.            (progn
125.              (setq drop (vlax-invoke _block 'getdynamicblockproperties ))
126.            (nth 0 drop)
127.              (setq _len1 (vlax-variant-value  (vla-get-value (nth 0 drop) )))
128.             (setq quantity (fix (/ _len1 _lenbl)))
129.             (setq counter1 0)
130.             (while (< counter1 quantity)
131.               (setq x_coord` (+ x_coord (/ (+ _lenbl (/ (- _len1 (* quantity _lenbl)) quantity)) 2) (* 1 counter1 (+ _lenbl (/ (- _len1 (* quantity _lenbl)) quantity)))))
132.                 (setq poinsert (vlax-3d-point x_coord` y_coord z_coord))
133.              (vla-InsertBlock mspace poinsert  name xscale yscale zscale rot1)
134.                                (setq counter1 (+ 1 counter1))(princ "ok !Дверной проем")(terpri))
135.             )
136.                      
137.      )))
138.     (princ counter)
139.           (vla-highlight _block :vlax-false)
140.           (setq counter (+ 1 counter))(terpri)(princ "Расстановка выполнена"))
141.                  )))
142.                    (progn
143.                      (alert (princ "\nНет блоков, расположите блоки на фасаде здания"))
144. (terpri))
145.         )
146.   (princ))

Традиционно прикладываю файл с описанием блоков для прогонки макроса тем, кому интересно

[Алексей Кулик]

"Я опять насчет стрельца"...
Дураказащиты опять нет. ИМХО многовато переменных (и не все они локализованы). Откуда я буду знать имя блока (который "см.палитру")? Может, проще будет выполнить "проход" по допустимым именам блоков и предлагать их через getkword (например)?
Если честно, я бы подумал о создании dcl-диалога и прописывании в нем всех необходимых параметров - это было бы удобнее пользователям. Да и в некоторых случаях с диалогом проще работать.
Сугубо ИМХО: если добавить дураказащиту, код удлинится. Если просто убрать лишние шаги - укоротится. Что делать будем?

[Алексей Кулик]

Добавлю: я бы все-таки запросы внутри цикла, наверное, убрал.

[Peacemaker_kiss]

Может, проще будет выполнить "проход" по допустимым именам блоков и предлагать их через getkword (например)?

Не поверишь, сегодня с утра бегал, именно об этом пришла мысль в голову! Конечно буду делать так, чтобы пользователь ничего лапками не вводил, и соглашусь с тем, что пора расти до меню, построенном на dcl-диалоге