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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Поделитесь макросом отрисовки проёма

Поделитесь макросом отрисовки проёма

Ответ
Поиск в этой теме
Непрочитано 14.02.2020, 10:47 #1
Поделитесь макросом отрисовки проёма
MrBrown
 
ПенсионЭр
 
Регистрация: 26.06.2009
Сообщений: 359

Здравствуйте!

Нужен макрос для оцифровки старых планов БТИ.
(слегка бесит однообразная отрисовка центральной линии)

После запуска макроса рисуем в стене прямоугольник (если стена горизонтальная или вертикальная) или пару полилиний 1 и 2 в любом порядке (если стена диагональная).
Макрос отрисовывает прямоугольник и центральную линию, выступающую за границы прямоугольника на величину 0,7 короткой стороны прямоугольника, т.е. на 0,7 толщины стены.
Штриховку созданный элемент перекрывает.
Слой отрисовки элемента, цвет, вес и т.д. полилинии - текущие.
Работа макроса - циклом.
Выход - по Esc.
Спасибо.

p.s. В интернете нарыл массу разных красивых макросов и динамических блоков. Мне - не подходят.
p.p.s Если такого макроса не существует, что ж, пойду в "поиск исполнителей".

Вложения
Тип файла: dwg
DWG 2010
Проём.dwg (101.1 Кб, 10 просмотров)

Просмотров: 1809
 
Непрочитано 14.02.2020, 10:48
#2
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Динамический блок -самое простое и дешевое решение.
Boxa вне форума  
 
Автор темы   Непрочитано 14.02.2020, 11:01
#3
MrBrown

ПенсионЭр
 
Регистрация: 26.06.2009
Сообщений: 359


Boxa, Так его тоже копировать надо! А это масса лишних движений (ИМХО).
MrBrown вне форума  
 
Непрочитано 14.02.2020, 11:02
#4
Кулик Алексей aka kpblc
Moderator

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


Ctrl+3, загнать блок туда и однажды настроить.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.02.2020, 11:09
#5
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Тогда могу еще вспомнить такую тему: https://forum.dwg.ru/showthread.php?t=137383
Boxa вне форума  
 
Непрочитано 14.02.2020, 12:34
1 | #6
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,989


Цитата:
Сообщение от MrBrown Посмотреть сообщение
Макрос отрисовывает прямоугольник и центральную линию, выступающую за границы прямоугольника на величину 0,7 короткой стороны прямоугольника, т.е. на 0,7 толщины стены.
Код:
[Выделить все]
 

(DEFUN C:Doorway (/
                 IP
                 THK
                 ANG
                 L
                 P1
                 P2
                 P3
                 P4
                 P5
                 P6
                 P7
                 P8
                 P9
                 P10
                 P11
                 P12
                 P13
                 P14
               P15
               P16
                )
;;;*----------------------------------------------------------


  

;;;*INITIALISE
  (SETQ doc (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
  (VLA-STARTUNDOMARK doc)
  (initerr)
  (SETVAR "CMDECHO" 0)
  (SETVAR "BLIPMODE" 0)
  (SETVAR "OSMODE" OLDSNAP)

;;;*----------------------------------------------------------
  (INITGET 1)
  (SETQ IP  (GETPOINT "\nInsertion Point : ")
        P11 (GETPOINT IP "\nWall Thickness : ")
  ) ;setq
  (SETVAR "OSMODE" 0)
    ;(setvar "PICKBOX" 0)

(setq L   (GETdist "\nLength of Door : "))
    (if (= L nil) (setq L 900))
  (SETQ ANG (ANGLE IP P11)
        ANG (RTD ANG)
        ANG (+ ANG 90.0)
        THK (DISTANCE IP P11)
;;;        L   (GETdist "\nLength of Door : ")
        P1  (POLAR IP (DTR (+ ANG 180.0)) (/ L 2))
        P2  (POLAR P1 (DTR (+ ANG 270.0)) (+ THK 0.0))
        P3  (POLAR P2 (DTR ANG) L)
        P4  (POLAR P3 (DTR (+ ANG 90.0)) (+ THK 0.0))
        P5  (POLAR P1 (DTR (+ ANG 270.0)) (/ THK 2))
        P6  (POLAR P5 (DTR (+ ANG 90.0)) (/ THK 8))
        P7  (POLAR P6 (DTR (+ ANG 270.0)) (/ THK 4))
        P8  (POLAR P5 (DTR ANG) L)
        P9  (POLAR P6 (DTR ANG) L)
        P10 (POLAR P7 (DTR ANG) L)
        P12 (POLAR P11 (DTR (+ ANG 180.0)) (/ L 1))
        P13 (POLAR P11 (DTR ANG) (/ L 2))
        P14 (POLAR P11 (DTR ANG) 100.0)
        P15 (POLAR IP (DTR (+ ANG 270.0)) (* THK 1.7))
        P16 (POLAR IP (DTR (+ ANG 90.0)) (* THK 0.7))
  ) ;setq


  (COMMAND "_pLINE"
           P1
           P2
           P3
           P4
           "_c"
           "_LINE"
           P15
           P16
           ""
          
    ;"_BREAK" P14 "_F" P12 P13
    ;"_ERASE" P11 ""
  ) ;command
  (VLA-ENDUNDOMARK doc)
;;;*RESET ENVIROMENT
  (reset)
;;;  (SETVAR "clayer" oldClayer)
  (PRINC)


)  
;;;*==========================================================
(DEFUN initerr ()
  (SETQ oldlayer (GETVAR "clayer"))
  (SETQ oldsnap (GETVAR "osmode"))
  (SETQ oldpick (GETVAR "pickbox"))

(SETVAR "cmdecho" 0)
  (SETQ oldClayer (GETVAR "clayer"))
  (IF (NOT (TBLSEARCH "layer" "Проемы"))
    (PROGN (COMMAND "_.layer" "_new" "Проемы" "") ;имя слоя
           (COMMAND "_.layer" "_lw" 0.3 "Проемы" "")
;;;вес линий
           (COMMAND "_.layer" "_c" 170 "Проемы" "") ;цвет
           (SETVAR "clayer" "Проемы")
    ) ;_ end progn
    (SETVAR "clayer" "Проемы")
  ) ;_ end if
  (SETVAR "cmdecho" 1)
  
  (SETQ temperr *error*)
  (SETQ *error* trap)
  (PRINC)
)   ;defun
;;;*===========================================================
(DEFUN trap (errmsg)
  (COMMAND nil nil nil)
  (IF (NOT (MEMBER errmsg '("console _BREAK" "Function Cancelled"))
      ) ;_ end of not
    (PRINC (STRCAT "\nError: " errmsg))
  ) ;                 
  (SETVAR "clayer" oldlayer)
  (SETVAR "BLIPMODE" 0)
  (SETVAR "menuecho" 0)
  (SETVAR "highlight" 1)
  (SETVAR "osmode" oldsnap)
  (SETVAR "pickbox" oldpick)
  (PRINC "\nError Resetting Enviroment ")
  (TERPRI)
  (SETQ *error* temperr)
  (PRINC)
)   ;defun
;;;*===========================================================
(DEFUN reset ()
  (SETQ *error* temperr)
  (SETVAR "clayer" oldlayer)
  (SETVAR "BLIPMODE" 0)
  (SETVAR "menuecho" 0)
  (SETVAR "highlight" 1)
  (SETVAR "osmode" oldsnap)
  (SETVAR "pickbox" oldpick)
  (PRINC)
)   ;defun
;;;*======================================================
    ;*-----------------------------------------------------------------------------
    ;*dtr converts degrees to radians
(DEFUN dtr (a)
  (* PI (/ a 180))
)   ;defun
    ;*-----------------------------------------------------------------------------
    ;*rtd converts radians to degrees
(DEFUN rtd (a)
  (/ (* a 180) PI)
)   ;defun
    ;*-----------------------------------------------------------------------------
(PRINC)
Миниатюры
Нажмите на изображение для увеличения
Название: doors.gif
Просмотров: 58
Размер:	185.4 Кб
ID:	223125  

Последний раз редактировалось Nike, 14.02.2020 в 12:47.
Nike вне форума  
 
Автор темы   Непрочитано 14.02.2020, 13:05
#7
MrBrown

ПенсионЭр
 
Регистрация: 26.06.2009
Сообщений: 359


Nike, Спасибо! В принципе, годится.
Было бы замечательно, если бы длину проёма не нужно было указывать, набирая на клавиатуре, а просто протягивая курсор в любую сторону по контуру стены от центральной линии проёма.
В моём случае оцифровки бумажных чертежей точные размеры проёмов некритичны.

p.s. Кроме "спасибо" хочу переслать Вам разумную денежку за эту услугу. Моё мнение: альтруизм особо нуждается в поддержке и не только моральной.
Прошу в личке сообщить мне Яндекс-кошелёк или Qiwi, или номер телефона, чтобы я отблагодарил "не только морально".
)
MrBrown вне форума  
 
Непрочитано 14.02.2020, 13:10
1 | #8
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от MrBrown Посмотреть сообщение
длину проёма не нужно было указывать, набирая на клавиатуре
Так там и так стоит указание дистанции. Ну, если хочешь , замени
Код:
[Выделить все]
 (GETdist "\nLength of Door : "))
на
Код:
[Выделить все]
 (GETdist  IP "\nLength of Door : "))
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 14.02.2020, 13:24
#9
MrBrown

ПенсионЭр
 
Регистрация: 26.06.2009
Сообщений: 359


Кулик Алексей aka kpblc, да, я глянул в код. Там по умолчанию стоит L=900мм.
А строчку - сейчас заменю и отпишусь.
Спасибо.

----- добавлено через ~4 мин. -----
Кулик Алексей aka kpblc, Получилось. Моя благодарность. Теперь макрос полностью заточен под мою "хотелку".

________________
Увы, не полностью: штриховку стены не перекрывает. Как бы добавить в код заплатку (Wipeout)?

Последний раз редактировалось MrBrown, 14.02.2020 в 13:37.
MrBrown вне форума  
 
Непрочитано 14.02.2020, 13:58
#10
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,989


Цитата:
Сообщение от MrBrown Посмотреть сообщение
p.s. Кроме "спасибо" хочу переслать Вам разумную денежку за эту услугу. Моё мнение: альтруизм особо нуждается в поддержке и не только моральной.
Прошу в личке сообщить мне Яндекс-кошелёк или Qiwi, или номер телефона, чтобы я отблагодарил "не только морально".
Счас кину чем-нибудь тяжелым!
Сам нашел не помню где.

Цитата:
Сообщение от MrBrown Посмотреть сообщение
Как бы добавить в код заплатку (Wipeout)?
Перед
(COMMAND "_pLINE"
вставить
(COMMAND "_WIPEOUT" P1 P2 P3 P4 "")

ЗЫ
Вот так будет рисовать окна:
Код:
[Выделить все]
 (SETQ ANG (ANGLE IP P11)
        ANG (RTD ANG)
        ANG (+ ANG 90.0)
        THK (DISTANCE IP P11)
        L   (GETdist "\nLength of Window : ")
        P1  (POLAR IP (DTR (+ ANG 180.0)) (/ L 2))
        P2  (POLAR P1 (DTR (+ ANG 270.0)) (+ THK 0.0))
        P3  (POLAR P2 (DTR ANG) L)
        P4  (POLAR P3 (DTR (+ ANG 90.0)) (+ THK 0.0))
        P5  (POLAR P1 (DTR (+ ANG 270.0)) (/ THK 2))
        P6  (POLAR P5 (DTR (+ ANG 90.0)) (/ THK 8))
        P7  (POLAR P6 (DTR (+ ANG 270.0)) (/ THK 4))
        P8  (POLAR P5 (DTR ANG) L)
        P9  (POLAR P6 (DTR ANG) L)
        P10 (POLAR P7 (DTR ANG) L)
        P12 (POLAR P11 (DTR (+ ANG 180.0)) (/ L 2))
        P13 (POLAR P11 (DTR ANG) (/ L 2))
        P14 (POLAR P11 (DTR ANG) 100.0)
  ) ;setq

  (COMMAND "_pLINE"
           P1
           P2
           P3
           P4
           "_c"
           "_LINE"
           P6
           P9
           ""
           "_LINE"
           P7
           P10
           ""
  ) ;command
В прицепе прога подходящая для рисования стен.
Вложения
Тип файла: lsp DLINE Version 1.12 MODIFIED BY CAD STUDIO.LSP (67.0 Кб, 10 просмотров)

Последний раз редактировалось Nike, 14.02.2020 в 14:08.
Nike вне форума  
 
Автор темы   Непрочитано 14.02.2020, 14:10
#11
MrBrown

ПенсионЭр
 
Регистрация: 26.06.2009
Сообщений: 359


Nike, не работает. Ком.строка пишет:

Length of Door :
Неверная точка.
Error: Функция отменена

(это я про _WIPEOUT)

Получилось! Вставил не после строчки, а перед ней.

Последний раз редактировалось MrBrown, 14.02.2020 в 14:26.
MrBrown вне форума  
 
Непрочитано 14.02.2020, 14:19
#12
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,989


Цитата:
Сообщение от MrBrown Посмотреть сообщение
не работает. Ком.строка пишет:

Length of Door :
Неверная точка.
Error: Функция отменена

Не могу воспроизвести. У меня все работает.
Миниатюры
Нажмите на изображение для увеличения
Название: 2.gif
Просмотров: 29
Размер:	73.6 Кб
ID:	223129  
Nike вне форума  
 
Непрочитано 14.02.2020, 14:31
#13
Кулик Алексей aka kpblc
Moderator

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


Фигню написал.

----- добавлено через ~44 мин. -----
Еще один вариант, просто поиграться:
Код:
[Выделить все]
 (vl-load-com)
(defun c:doorway (/ fun_conv-vla-to-list fun_single-block adoc def ref)
  (defun fun_conv-vla-to-list (value / res)
    (cond ((listp value) (mapcar (function fun_conv-vla-to-list) value))
          ((= (type value) 'variant) (fun_conv-vla-to-list (vlax-variant-value value)))
          ((= (type value) 'safearray)
           (if (>= (vlax-safearray-get-u-bound value 1) 0)
             (fun_conv-vla-to-list (vlax-safearray->list value))
             ) ;_ end of if
           )
          ((= (type value) 'ename) (fun_conv-vla-to-list (vlax-ename->vla-object value)))
          ((and (= (type value) 'vla-object) (vlax-property-available-p value 'count))
           (vlax-for sub value (setq res (cons sub res)))
           (reverse res)
           )
          (t value)
          ) ;_ end of cond
    ) ;_ end of defun
  (defun fun_single-block (doc block-name / def wipeout lastent contour center)
    (if (tblobjname "block" block-name)
      (vla-item (vla-get-blocks doc) block-name)
      (progn (setq layer_status (mapcar (function
                                          (lambda (item)
                                            (cons item
                                                  (mapcar (function (lambda (pr / temp)
                                                                      (setq temp (vlax-get-property item pr))
                                                                      (vl-catch-all-apply (function (lambda () (vlax-put-property item pr :vlax-false))))
                                                                      (cons pr temp)
                                                                      ) ;_ end of LAMBDA
                                                                    ) ;_ end of function
                                                          '("lock" "freeze")
                                                          ) ;_ end of mapcar
                                                  ) ;_ end of cons
                                            ) ;_ end of LAMBDA
                                          ) ;_ end of function
                                        (fun_conv-vla-to-list (vla-get-layers doc))
                                        ) ;_ end of mapcar
                   ) ;_ end of setq
             (setq def (vla-add (vla-get-blocks doc) (vlax-3d-point '(0. 0. 0.)) block-name))
             (setq lastent (entlast))
             (if (and (not
                        (vl-catch-all-error-p
                          (vl-catch-all-apply
                            (function
                              (lambda ()
                                (vl-cmdf "_.wipeout" "_none" '(0. 0.) "_none" '(1. 0.) "_none" '(1. 1.) "_none" '(0. 1.) "")
                                (apply (function vl-cmdf) (list "_.wipeout" '(0. 0.) '(1. 0.) '(1. 1.) '(0. 1.) ""))
                                ) ;_ end of lambda
                              ) ;_ end of function
                            ) ;_ end of vl-catch-all-apply
                          ) ;_ end of vl-catch-all-error-p
                        ) ;_ end of not
                      (not (equal lastent (entlast)))
                      ) ;_ end of and
               (progn (setq wipeout (vlax-ename->vla-object (entlast)))
                      (vla-copyobjects adoc
                                       (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list wipeout))
                                                          ) ;_ end of vlax-make-variant
                                       def
                                       ) ;_ end of vla-CopyObjects
                      (vla-erase wipeout)
                      ) ;_ end of progn
               ) ;_ end of if
             (setq contour (vla-addlightweightpolyline def
                                                       (vlax-make-variant
                                                         (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 7)) '(0. 0. 1. 0. 1. 1. 0. 1.))
                                                         ) ;_ end of vlax-make-variant
                                                       ) ;_ end of vla-AddLightWeightPolyline
                   ) ;_ end of setq
             (vla-put-closed contour :vlax-true)
             (vla-put-constantwidth contour 0.)
             (setq center (vla-addline def (vlax-3d-point '(0.5 -0.35)) (vlax-3d-point '(0.5 1.35))))
             (vlax-for sub def
               (vla-put-layer sub "0")
               (vla-put-lineweight sub aclnwtbyblock)
               (vla-put-color sub 0)
               (vla-put-linetype sub "byblock")
               ) ;_ end of vlax-for
             (foreach item layer_status
               (foreach pr (cdr item)
                 (vl-catch-all-apply (function (lambda () (vlax-put-property (car item) (car pr) (cdr pr)))))
                 ) ;_ end of foreach
               ) ;_ end of foreach
             def
             ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of defun
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        def  (fun_single-block adoc "DoorHole")
        ) ;_ end of setq
  (while (and (= (type
                   (setq ins_pt (vl-catch-all-apply (function (lambda () (getpoint "\nInsertion point <Cancel> : ")))))
                   ) ;_ end of type
                 'list
                 ) ;_ end of =
              ins_pt
              (= (type
                   (setq len (vl-catch-all-apply (function (lambda () (getpoint ins_pt "\nLength <Cancel> : ")))))
                   ) ;_ end of type
                 'list
                 ) ;_ end of member
              len
              (member (type
                        (setq width (vl-catch-all-apply (function (lambda () (getdist ins_pt "\nWidth <Cancel> : ")))))
                        ) ;_ end of type
                      (list 'ins 'real)
                      ) ;_ end of =
              (> width 0.)
              ) ;_ end of and
    (vla-startundomark adoc)
    (setq ref (vla-insertblock (vla-get-modelspace adoc)
                               (vlax-3d-point ins_pt)
                               (vla-get-name def)
                               (distance ins_pt len)
                               width
                               1.
                               (angle ins_pt len)
                               ) ;_ end of vla-InsertBlock
          ) ;_ end of setq
    (vla-endundomark adoc)
    ) ;_ end of while
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.

Последний раз редактировалось Кулик Алексей aka kpblc, 14.02.2020 в 15:56.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 14.02.2020, 15:38
#14
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
'varian
variant
koMon вне форума  
 
Непрочитано 14.02.2020, 15:56
#15
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от koMon Посмотреть сообщение
variant
О, спасибо! Исправил.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Поделитесь макросом отрисовки проёма

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
С экрана пропала область отрисовки в SW2017 Stich123 SolidWorks 0 11.07.2018 15:02
Усиление проёма выполняемого проёма в несущей стене при наличии доступа лишь с одной стороны sterh220 Конструкции зданий и сооружений 3 27.06.2017 12:53
Можно ли пробить шурф под балкой оконного проёма? Кулибин1 Железобетонные конструкции 7 30.08.2016 08:36
aimp 3 Поделитесь мнением! gomer Прочее. Программное обеспечение 8 02.04.2011 00:32
Обрамление проёма секционных ворот в сендвич панелях Heartless Поиск литературы, чертежей, моделей и прочих материалов 0 10.12.2008 15:57