dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Слой и стили. Их создание, установка текущими, и возврат к исходному состоянию после завершения команды

Слой и стили. Их создание, установка текущими, и возврат к исходному состоянию после завершения команды

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 19.02.2018, 19:58 #1
Слой и стили. Их создание, установка текущими, и возврат к исходному состоянию после завершения команды
Browning Zed
 
Регистрация: 17.01.2014
Сообщений: 37

Browning Zed вне форума Вставить имя

Всем привет. Пытаюсь доработать под себя ряд программ, чтобы объекты с помощью которых они создаются, располагались на определенных слоях и им присваивались определенные стили. Конкретно в данном примере - построение выноски с координатами.
Цель такова: посредством ряда функций создаем текстовой стиль, стиль мультивыноски, слой. Устанавливаем их текущими.
Далее запускается циклическая команда построения выноски. После того как мы обрываем команду, все стили, и слой должны вернуться в исходное состояние, стать такими как до выполнения команды. Пытался сообразить нечто подобное, но ничего не выходит - слой и стили создаются, но программа перестает работать должным образом. Ногами не бить - я ни разу не программист, даже близко. Все лисп-функции и сама программа построения выноски честно скопипащены с просторов интернета. Помогите разобраться.
Код:
[Выделить все]
 (defun create-text-style ()
 (if (not (tblsearch "STYLE" "ГОСТ ISO"))
    (entmake '((0 . "STYLE")
                     (100 . "AcDbSymbolTableRecord") 
                     (100 . "AcDbTextStyleTableRecord") 
                     (2 . "ГОСТ ISO"); название стиля 
                     (3 . "ISOCPEUR"); файл шрифта 
                     (70 . 0) 
                     (40 . 0.0) 
                     (41 . 1.0) 
                     (50 . 0.0) 
                     (71 . 0) 
                    ) 
    )
 )
)
(defun create-layer-and-set (/ layname laycol ltname lay)
  (vl-load-com)
	(setq 
		  layname	"Выноски"		; имя слоя 
          laycol	5				; цвет слоя
		  ltname	"Continuous"	; тип линии слоя
		)
  (if (not (tblsearch "LTYPE" ltname))
    (vla-load
      (vla-get-Linetypes
        (vla-get-ActiveDocument
          (vlax-get-acad-object))) ltname "acad.lin"))
  (if (not (tblsearch "LAYER" layname))
    (progn
      (setq lay (vla-add
                  (vla-get-layers
                    (vla-get-ActiveDocument
                      (vlax-get-acad-object))) layname))
      (vla-put-color lay laycol)
      (vla-put-linetype lay ltname)))
	(setvar "CLAYER" layname)
 )

(defun create-mleader-style 
  ( mleaderstylename  / mldrdict newldrstyle textcolor leadercolor objcolor dimblk)
  (if (not (member (cons 3 mleaderstylename)(DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE")))
    (progn
      (setq dimblk nil)
      (or dimblk (setq dimblk "_None")); dimblk (имя блока на конце) ""
      (setq mldrdict (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
      (setq newldrstyle (vlax-invoke mldrdict 'addobject mleaderstylename "AcDbMLeaderStyle"))
      (setq textcolor acByBlock); Цвет текста
      (setq leadercolor acByBlock); Цвет выноски
      (setq objcolor (vla-getinterfaceobject
		       (vlax-get-acad-object)
		       (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2))
		       );_vla-getinterfaceobject
	    );_setq
      (vla-put-ColorIndex objcolor textcolor)
      (vla-put-TextColor newldrstyle objcolor)
      (vla-put-ColorIndex objcolor leadercolor)
      (vla-put-LeaderLineColor newldrstyle objcolor)
      (if (not (tblobjname "block" dimblk))
	(progn
	  (setq textcolor (getvar "dimblk"))
	  (if (VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY 'setvar (list "dimblk" dimblk)))
	    (setvar "dimblk" (setq dimblk "_None"))
	    )
	  (setvar "dimblk" (if (= textcolor "") "." textcolor))
	  )
	)
      (foreach item
	       (list
		 '("AlignSpace" 5.0)
		 '("Annotative" 0)
		 '("ArrowSize" 1.0); размер стрелки
		 (list "ArrowSymbol"  dimblk)
		 '("BitFlags" 0)
		 '("BlockConnectionType" 0)
		 '("BlockRotation" 0.0)
		 '("BlockScale" 1.0)
		 '("BreakSize" 0.125)
		 '("ContentType" 2)
		 '("Description"  "Стиль для подписей")
		 '("DoglegLength" 0.3)
		 '("DrawLeaderOrderType" 0)
		 '("DrawMLeaderOrderType" 1)
		 '("EnableBlockRotation" -1)
		 '("EnableBlockScale" -1)
		 '("EnableDogleg" -1)
		 '("EnableFrameText" 0)
		 '("EnableLanding" -1)
		 '("FirstSegmentAngleConstraint" 0)
		 '("LandingGap" 0.2)
		 '("LeaderLineType"  1); ("LeaderLineTypeId" "ByBlock"); "Continuous"
		 '("LeaderLineTypeId" "Continuous"); "ByBlock"; ("LeaderLineWeight" 30); вес линий выноски
		 '("MaxLeaderSegmentsPoints" 2)
		 '("ScaleFactor" 1.0)
		 '("SecondSegmentAngleConstraint"  0)
		 '("TextAlignmentType" 0)
		 '("TextAngleType" 0)
		 '("TextHeight" 2.1); высота текста
		 '("TextLeftAttachmentType" 3)
		 '("TextRightAttachmentType" 3)
		 '("TextString"  "")
		 (list "TextStyle" (getvar "TEXTSTYLE")); устанавливает стиль текста
		 )
	(vlax-put-property newldrstyle (car item)(cadr item))
	)
      )
    newldrstyle
    )
  )
(defun c:xyz_mleader (/ pod_z koord  xyz)
  (setq orig-tstyle (getvar "TEXTSTYLE")); запоминает исходный текстовой стиль
  (create-text-style); создает новый текстовой стиль
  (setvar "TEXTSTYLE" "ГОСТ ISO"); устанавливает вновь созданный текстовой стиль в качестве текущего
  (create-mleader-style "Подписи"); создает стиль мультивыноски
  (setq orig-layer (getvar "CLAYER")); запоминает исходный слой
  (create-layer-and-set); создает новый слой
(initget "Да Нет Lf Ytn _ Y N Y N")
  (setq
    pod_z (getkword "\nПодписывать Z [Да/Нет] <Нет>? : ")
  )
  (while (and
      (setq koord (getpoint "\nТочка <Выход>"))
    )
    (setq
    ; xyz  (strcat "Y=" (rtos (nth 0 koord) 2 3)"\nX=" (rtos (nth 1 koord) 2 3)(if
      xyz  (strcat "X=" (rtos (nth 1 koord) 2 3)"\nY=" (rtos (nth 0 koord) 2 3)(if
    (= pod_z "Y")
      (strcat "\nZ=" (rtos (nth 2 koord) 2 3))
      ""
  ))
    )
    (VL-cmdf "_mleader" koord pause  xyz "")
  )
  (setvar "CLAYER" orig-layer); возвращает исходный слой
  (setvar "TEXTSTYLE" orig-tstyle); возвращает исходный текстовой стиль
)
(princ)
Просмотров: 1443
 
Непрочитано 19.02.2018, 20:26
#2
Кулик Алексей aka kpblc
Moderator

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


Ты хочешь, чтобы тебе код переработали или подсказали идеи, как надо сделать?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 19.02.2018, 20:29
#3
Browning Zed


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


Если не затруднит, показать как должен выглядеть рабочий код.
Browning Zed вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 20.02.2018, 19:15
#4
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,654
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Browning Zed Посмотреть сообщение
После того как мы обрываем команду, все стили, и слой должны вернуться в исходное состояние, стать такими как до выполнения команды
Цитата:
Сообщение от Browning Zed Посмотреть сообщение
Если не затруднит, показать как должен выглядеть рабочий код.
Как вариант. Код не проверял, но если твои функции рабочие, то должен работать
Код:
[Выделить все]
 
 (defun create-text-style ()
 (if (not (tblsearch "STYLE" "ГОСТ ISO"))
    (entmake '((0 . "STYLE")
                     (100 . "AcDbSymbolTableRecord") 
                     (100 . "AcDbTextStyleTableRecord") 
                     (2 . "ГОСТ ISO"); название стиля 
                     (3 . "ISOCPEUR"); файл шрифта 
                     (70 . 0) 
                     (40 . 0.0) 
                     (41 . 1.0) 
                     (50 . 0.0) 
                     (71 . 0) 
                    ) 
    )
 )
)
(defun create-layer-and-set (/ layname laycol ltname lay)
  (vl-load-com)
	(setq 
		  layname	"Выноски"		; имя слоя 
          laycol	5				; цвет слоя
		  ltname	"Continuous"	; тип линии слоя
		)
  (if (not (tblsearch "LTYPE" ltname))
    (vla-load
      (vla-get-Linetypes
        (vla-get-ActiveDocument
          (vlax-get-acad-object))) ltname "acad.lin"))
  (if (not (tblsearch "LAYER" layname))
    (progn
      (setq lay (vla-add
                  (vla-get-layers
                    (vla-get-ActiveDocument
                      (vlax-get-acad-object))) layname))
      (vla-put-color lay laycol)
      (vla-put-linetype lay ltname)))
	(setvar "CLAYER" layname)
 )

(defun create-mleader-style 
  ( mleaderstylename  / mldrdict newldrstyle textcolor leadercolor objcolor dimblk)
  (if (not (member (cons 3 mleaderstylename)(DICTSEARCH (NAMEDOBJDICT) "ACAD_MLEADERSTYLE")))
    (progn
      (setq dimblk nil)
      (or dimblk (setq dimblk "_None")); dimblk (имя блока на конце) ""
      (setq mldrdict (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
      (setq newldrstyle (vlax-invoke mldrdict 'addobject mleaderstylename "AcDbMLeaderStyle"))
      (setq textcolor acByBlock); Цвет текста
      (setq leadercolor acByBlock); Цвет выноски
      (setq objcolor (vla-getinterfaceobject
		       (vlax-get-acad-object)
		       (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2))
		       );_vla-getinterfaceobject
	    );_setq
      (vla-put-ColorIndex objcolor textcolor)
      (vla-put-TextColor newldrstyle objcolor)
      (vla-put-ColorIndex objcolor leadercolor)
      (vla-put-LeaderLineColor newldrstyle objcolor)
      (if (not (tblobjname "block" dimblk))
	(progn
	  (setq textcolor (getvar "dimblk"))
	  (if (VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY 'setvar (list "dimblk" dimblk)))
	    (setvar "dimblk" (setq dimblk "_None"))
	    )
	  (setvar "dimblk" (if (= textcolor "") "." textcolor))
	  )
	)
      (foreach item
	       (list
		 '("AlignSpace" 5.0)
		 '("Annotative" 0)
		 '("ArrowSize" 1.0); размер стрелки
		 (list "ArrowSymbol"  dimblk)
		 '("BitFlags" 0)
		 '("BlockConnectionType" 0)
		 '("BlockRotation" 0.0)
		 '("BlockScale" 1.0)
		 '("BreakSize" 0.125)
		 '("ContentType" 2)
		 '("Description"  "Стиль для подписей")
		 '("DoglegLength" 0.3)
		 '("DrawLeaderOrderType" 0)
		 '("DrawMLeaderOrderType" 1)
		 '("EnableBlockRotation" -1)
		 '("EnableBlockScale" -1)
		 '("EnableDogleg" -1)
		 '("EnableFrameText" 0)
		 '("EnableLanding" -1)
		 '("FirstSegmentAngleConstraint" 0)
		 '("LandingGap" 0.2)
		 '("LeaderLineType"  1); ("LeaderLineTypeId" "ByBlock"); "Continuous"
		 '("LeaderLineTypeId" "Continuous"); "ByBlock"; ("LeaderLineWeight" 30); вес линий выноски
		 '("MaxLeaderSegmentsPoints" 2)
		 '("ScaleFactor" 1.0)
		 '("SecondSegmentAngleConstraint"  0)
		 '("TextAlignmentType" 0)
		 '("TextAngleType" 0)
		 '("TextHeight" 2.1); высота текста
		 '("TextLeftAttachmentType" 3)
		 '("TextRightAttachmentType" 3)
		 '("TextString"  "")
		 (list "TextStyle" (getvar "TEXTSTYLE")); устанавливает стиль текста
		 )
	(vlax-put-property newldrstyle (car item)(cadr item))
	)
      )
    newldrstyle
    )
  )
 
(defun c:xyz_mleader (/ pod_z koord xyz)
  (vl-load-com)
  (kpblc-error-save-sysvar
    (list
      '("osmode")
      '("CLAYER")
      '("CMDECHO" 0)
      '("EXPERT" 5)
      '("highlight" 1)
      '("cecolor" "bylayer")
      '("CELTYPE" "bylayer")
      '("TEXTSTYLE")
      '("CMLSTYLE")
    ) ;_ end of list
  ) ;_ end of kpblc-error-save-sysvar
  (vl-catch-all-apply
    '(lambda ()
       (create-text-style) ;_ создает новый текстовой стиль
       (setvar "TEXTSTYLE" "ГОСТ ISO") ;_ устанавливает вновь созданный текстовой стиль в качестве текущего
       (create-mleader-style "Подписи") ;_ создает стиль мультивыноски
       (create-layer-and-set) ;_ создает новый слой
       (initget "Да Нет Lf Ytn _ Y N Y N")
       (setq
         pod_z (getkword "\nПодписывать Z [Да/Нет] <Нет>? : ")
       ) ;_ end of setq
       (while (and
                (setq koord (getpoint "\nТочка <Выход>"))
              ) ;_ end of and
         (setq  ;_ xyz  (strcat "Y=" (rtos (nth 0 koord) 2 3)"\nX=" (rtos (nth 1 koord) 2 3)(if
           xyz (strcat "X="
                       (rtos (nth 1 koord) 2 3)
                       "\nY="
                       (rtos (nth 0 koord) 2 3)
                       (if
                         (= pod_z "Y")
                          (strcat "\nZ=" (rtos (nth 2 koord) 2 3))
                          ""
                       ) ;_ end of if
               ) ;_ end of strcat
         ) ;_ end of setq
         (vl-cmdf "_mleader"  "_none" koord  pause xyz)
         (vla-put-StyleName (vlax-ename->vla-object(entlast)) "Подписи")
       ) ;_ end of while
     ) ;_ end of lambda
  ) ;_ end of vl-catch-all-apply
  (kpblc-error-restore-sysvar)
) ;_ end of defun
(princ)

 ;|==============================================================
*    Восстанавливаются системные переменные. Значения системных переменных
* должны храниться в глобальном списке *kpblc-sysvar-list*. Если списка нет
* (nil), происходит просто выход.
*    Параметры вызова:
*  Нет
*    Примеры вызова:
(kpblc-error-restore-sysvar)
==============================================================|;
(defun kpblc-error-restore-sysvar ()
  (if *kpblc-sysvar-list*
    (foreach item *kpblc-sysvar-list*
      (_kpblc-sysvar-set (car item) (cadr item))
    ) ;_ end of foreach
  ) ;_ end of if
  (setq *kpblc-sysvar-list* nil)
  (gc)
) ;_ end of defun

;|================================================================
*    Сохраняется текущее значение системных переменных. Список
глобальный (*kpblc-sysvar-list*)
* При условии, что заданы значения, они устанавливаются.
*    Поскольку список *kpblc-sysvar-list* не обнуляется, в нем
хранится история изменения
* значений переменных.
*    Параметры вызова:
*  *kpblc-sysvar-list*  список системных переменных, состояние
которых надо сохранить.
*      Список состоит из подсписков (Переменная Значение)
*      В списке могут повторяться Переменные. В таком случае будет
*      установлено последнее значение.
*      Если в качестве второго параметра используется nil, то значение
*      системной переменной просто сохраняется.
*    Примеры вызова:
(kpblc-error-sysvar-list (list '("cmdecho" 0) '("blipmode")
'("osmode" 503)))
==============================================================|;
(defun kpblc-error-save-sysvar (sysvar-list)
  (foreach item sysvar-list
    (setq *kpblc-sysvar-list*
           (cons (list (car item) (getvar (car item)))
                 *kpblc-sysvar-list*
           ) ;_ end of cons
    ) ;_ end of setq
    (if (cadr item)
      (_kpblc-sysvar-set (car item) (cadr item))
    ) ;_ end of if
  ) ;_ end of foreach
) ;_ end of defun
;|*******************************************************************************
*    Установка системных переменных. Замена стандартному (setvar) для
* безошибочной обработки
*    Параметры вызова:
*  sysvar  имя системной переменной
*  value  устанавливаемое значение
*    Возвращаемое значение:
*  Установленное значение системной переменной либо nil в случае неудачи
=============================================================================|;
  (defun _kpblc-sysvar-set (sysvar value)
    (if (getvar sysvar)
      (if (and (= value "")
               (wcmatch (strcase sysvar t) "dim*")
               ) ;_ end of and
        (setvar sysvar ".")
        (vl-catch-all-apply 'setvar (list sysvar value))
        ) ;_ end of if
      ) ;_ end of if
    (getvar sysvar)
    ) ;_ end of defun
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 21.02.2018 в 00:17.
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 20.02.2018, 19:50
#5
Browning Zed


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


VVA,
Попробовал запустить код. Поначалу программа ругалась на отсутствие функции _kpblc-sysvar-set. Через поиск нашел ее на сайте и прописал в лисп. Теперь, после запуска, команда сразу возвращает "nil". В чем может быть причина?
Browning Zed вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 21.02.2018, 00:17
#6
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,654
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Обновил #4
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 21.02.2018, 15:39
#7
Browning Zed


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


Вот теперь все фурычит. Буду разбираться с работой этих функций. Благодарю!
Browning Zed вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 23.02.2018, 11:36
#8
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,654
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Browning Zed, В двух словах логика работы такая:
1. kpblc-error-save-sysvar - запоминаем значение интересующих нас переменных
2. Используем отливщик ошибок vl-catch-all-apply, где и происходит взаимедействие с пользователем. Если произошло исключение (ошибка в коде, пользователь прервал команду и т.п.)
то функция вернет отчет об ошибке, но прерывания самой команды не произойдет
3. kpblc-error-restore-sysvar восстанавливает значение сохраненных в п.1 переменных независимо как завершилось выполнение п.2
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Слой и стили. Их создание, установка текущими, и возврат к исходному состоянию после завершения команды

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

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужно на событие завершения открытия документа выполнить нек. команды Phelicks Программирование 2 19.11.2009 15:27
VBA в 2010 автокаде не дожидается завершения предыдущей команды NomadV Программирование 2 13.11.2009 22:30
Как программно подождать завершения команды DonVik Программирование 7 05.12.2008 15:23
Проблемма после команды MOVE *LUCKY* AutoCAD 6 12.07.2007 10:25
Прозрачные команды Vova AutoCAD 17 21.06.2006 05:33

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||