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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Автоматический перенос размеров на слой размеры. Break макро

Автоматический перенос размеров на слой размеры. Break макро

Ответ
Поиск в этой теме
Непрочитано 01.03.2005, 12:58
Автоматический перенос размеров на слой размеры. Break макро
Piton
 
Инженер строитель
 
Москва
Регистрация: 24.02.2005
Сообщений: 396

Подскажите макрос на кнопку чтоб команда break разрывала в двух указанных точках (First point, second break point). ACAD2005
---
Добавлено (спасибо VVA): Рабочие варианты
#25
#190
#272
#273

Последний раз редактировалось Кулик Алексей aka kpblc, 16.11.2012 в 13:42.
Просмотров: 171274
 
Непрочитано 24.02.2006, 11:00
#21
getr

Конструктор
 
Регистрация: 06.04.2005
Из тех ворот-откуда весь народ.
Сообщений: 356
<phrase 1=


Действительно СУПЕР! Начал пользоваться.А нельзя ли файл доработать так,чтобы при испоьзовании комманд Mtext и Dtext текст также бы ложился в свой слой,скажем-"Текст"?
getr вне форума  
 
Непрочитано 24.02.2006, 12:54
#22
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


Код:
[Выделить все]
;;;Автоматический перенос размеров на слой "размеры",
;;;заливки на слой "заливка" и  текста на слой "текст"

;;;Просто добавь этот файл в автозагрузку
(vl-load-com)
(setq layers (vla-get-layers
	       (vla-get-activedocument
		 (vlax-get-acad-object)
	       )
	     )
)

;;;-------------------------------------------------------------

(setq OldLayer (getvar "CLAYER"))
(vl-cmdf "layer" "m" "размеры" "c" 151 "" "") ;Да простят меня гуру...
(vl-cmdf "layer" "m" "штриховка" "c" 5 "" "")
(vl-cmdf "layer" "m" "текст" "c" 2 "" "")
(setvar "clayer" OldLayer)

;;;-------------------------------------------------------------

(vlr-command-reactor
  nil
  '((:vlr-commandWillStart . startCommand))
)
(vlr-command-reactor
  nil
  '((:vlr-commandEnded . endCommand))
)
(vlr-command-reactor
  nil
  '((:vlr-commandCancelled . endCommand))
)

;;;-------------------------------------------------------------

(defun startCommand (calling-reactor
		     startcommandInfo
		     /
		     thecommandstart
		    )
  (setq OldLayer (getvar "CLAYER"))
  (setq thecommandstart (nth 0 startcommandInfo))

  (cond
    ((wcmatch thecommandstart "DIM*")
     (setvar "clayer" "размеры")
    )
    ((wcmatch thecommandstart "*HATCH*")
     (setvar "clayer" "штриховка")
    )
    ((wcmatch thecommandstart "*TEXT")
     (setvar "clayer" "текст")
    )
  )
  (princ)
)

;;;-------------------------------------------------------------

(defun endCommand (calling-reactor
		   endcommandInfo
		   /
		   thecommandend
		  )
  (setq thecommandend (nth 0 endcommandInfo))

  (cond
    ((wcmatch thecommandend "DIM*")
     (setvar "clayer" OldLayer)
    )
    ((wcmatch thecommandend "*HATCH*")
     (setvar "clayer" OldLayer)
    )
    ((wcmatch thecommandend "*TEXT")
     (setvar "clayer" OldLayer)
    )
  )
  (princ)
)

;;;-------------------------------------------------------------

(princ)

;;;-------------------------------------------------------------
Кочетков Андрей вне форума  
 
Непрочитано 24.02.2006, 13:39
#23
VVA

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


Позволю себе несколько модернизировать текст. При вызове команды идет вызов реакторов несколько раз и Oldlayer не восстанавливает слой до вызова команды. А если его сделать списком и восставливать 0-й, то вроде все ок. Плюс добавил комментарии, так что добавить, чтобы любой другой примитив ложился на свой слой не составит труда.

Код:
[Выделить все]
;;; Автор идеи Torino, он же Кочетков Андрей 
;;;Автоматический перенос размеров на слой "размеры" 
;;;и заливки на слой "заливка" 
;;;Просто добавь этот файл в автозагрузку 
(vl-load-com) 
(setq *OldLayer* (getvar "CLAYER")) 
(vl-cmdf "_layer" "_make" "размеры" "_color" 151 "" "") ;_Создаем слой размеры и задаем цвет 151 ... 
(vl-cmdf "_layer" "_make" "штриховка" "_color" 5 "" "") ;_Создаем слой штриховка и задаем цвет 5 
(vl-cmdf "_layer" "_make" "Текст" "_color" 6 "" "")     ;_Создаем слой текст и задаем цвет 6 
(setvar "clayer" *OldLayer*) 
(setq *OldLayer* nil) 
;;;;;;По аналогии добавить создание своего слоя 
;;; ... 
;;;;;; 
;;;;;;------------------------------------------------------------- 
(if *vlr-cmd*
  (progn
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
    ) ;_ end of progn
  ) ;_ end of if
(if (not *vlr-cmd*)
  (setq	*vlr-cmd* (vlr-command-reactor "cmd"
		    '((:vlr-commandwillstart . cmd-start)
		      (:vlr-commandended . cmd-end)
		      (:vlr-commandcancelled . cmd-end)
		      (:vlr-commandfailed . cmd-end)))))
;;;;;;------------------------------------------------------------- 
(defun cmd-start (calling-reactor startcommandInfo / thecommandstart) 
   (setq thecommandstart (nth 0 startcommandInfo))
  (if (null *OldLayer*)(setq *OldLayer* (getvar "CLAYER")))
  (cond 
 ;;;_Реакция на начало команды DIM* (DIMALIGNED DIMLINEAR и все что начинается с DIM)    
    ((wcmatch thecommandstart "DIM*")  ;_Если выполнается команда DIM* 
     (setvar "clayer" "размеры")       ;_Слой размеры должен быть создан выше (vl-cmdf "_layer" ... 
    ) 
 ;;; Конец реакции на DIM*    
    ((wcmatch thecommandstart "*HATCH*") ;_Если выполнается команда *HATCH* 
     (setvar "clayer" "штриховка") 
    ) 
    ((wcmatch thecommandstart "*TEXT") ;_Если выполнается команда *TEXT (TEXT DTEXT) 
     (setvar "clayer" "Текст") 
    ) 
    (t nil)) 
  (princ)) 
 ;;;------------------------------------------------------------- 
(defun cmd-end (calling-reactor cmd / cmd_name)
(setq cmd_name (strcase (car cmd)))
(if (or
      (wcmatch cmd_name "*HATCH*") ;_Если выполнается команда DIM*
      (wcmatch cmd_name "DIM*")    ;_Если выполнается команда *HATCH*
      (wcmatch cmd_name "*TEXT")   ;_Если выполнается команда *TEXT (TEXT DTEXT) 
      )
  (progn
    (if *OldLayer* (setvar "clayer" *OldLayer*)) 
    (setq *OldLayer* nil)
    ))
 (princ))
VVA вне форума  
 
Непрочитано 24.02.2006, 14:28
#24
getr

Конструктор
 
Регистрация: 06.04.2005
Из тех ворот-откуда весь народ.
Сообщений: 356
<phrase 1=


->VVA
Попробовал ваш вариант.Все отлично!Единственное пожелание,чтобы при открытии чертежа текущим слоем был бы последний используемый.В данный момент текущим сразу становится слой "Текст".
getr вне форума  
 
Непрочитано 24.02.2006, 15:01
#25
VVA

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


Код:
[Выделить все]
;;; Автор идеи Kenny Ramage, Эдуард, Torino, он же Кочетков Андрей 
;;; Доработка Владимир Азарко (VVA)
;;; Опубликовано http://forum.dwg.ru/showpost.php?p=58664&postcount=25
;;;Автоматический перенос размеров на слой "размеры" 
;;;и заливки на слой "заливка" 
;;;Просто добавь этот файл в автозагрузку 
(vl-load-com) 
(if *vlr-cmd*
  (progn
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
    ) ;_ end of progn
  ) ;_ end of if
(setq *OldLayer* (getvar "CLAYER")) 
(vl-cmdf "_layer" "_make" "Размеры" "_color" 151 "" "") ;_Создаем слой размеры и задаем цвет 151 ... 
(vl-cmdf "_layer" "_make" "Штриховка" "_color" 5 "" "") ;_Создаем слой штриховка и задаем цвет 5 
(vl-cmdf "_layer" "_make" "Текст" "_color" 6 "" "")     ;_Создаем слой текст и задаем цвет 6
(vl-cmdf "_layer" "_make" "Таблицы" "_color" 6 "" "")   ;_Создаем слой таблицы и задаем цвет 6
(vl-cmdf "_layer" "_make" "Выноски" "_color" 6 "" "")   ;_Создаем слой выноски и задаем цвет 6
(setvar "clayer" *OldLayer*) 
(setq *OldLayer* nil) 
;;;;;;По аналогии добавить создание своего слоя 
;;; ... 
;;;;;; 
;;;;;;------------------------------------------------------------- 

(if (not *vlr-cmd*)
  (setq	*vlr-cmd* (vlr-command-reactor "cmd"
		    '((:vlr-commandwillstart . cmd-start)
		      (:vlr-commandended . cmd-end)
		      (:vlr-commandcancelled . cmd-end)
		      (:vlr-commandfailed . cmd-end)))))
;;;;;;------------------------------------------------------------- 
(defun cmd-start (calling-reactor startcommandInfo / thecommandstart) 
   (setq thecommandstart (nth 0 startcommandInfo))
  (if (null *OldLayer*)(setq *OldLayer* (getvar "CLAYER")))
  (cond 
 ;;;_Реакция на начало команды DIM* (DIMALIGNED DIMLINEAR и все что начинается с DIM)    
    ((wcmatch thecommandstart "DIM*")  ;_Если выполняется команда DIM* 
     (setvar "clayer" "размеры")       ;_Слой размеры должен быть создан выше (vl-cmdf "_layer" ... 
    ) 
 ;;; Конец реакции на DIM*    
    ((wcmatch thecommandstart "*HATCH*") ;_Если выполняется команда *HATCH* 
     (setvar "clayer" "штриховка") 
    ) 
    ((wcmatch thecommandstart "*TEXT") ;_Если выполняется команда *TEXT (TEXT DTEXT) 
     (setvar "clayer" "Текст") 
    )
    ((wcmatch thecommandstart "*TABLE") ;_Если выполняется команда *TABLE
     (setvar "clayer" "Таблицы") 
    )
    ((wcmatch thecommandstart "*LEADER") ;_Если выполняется команда *QLEADER MLEADER
     (setvar "clayer" "Выноски") 
    )
    (t (setq *OldLayer* nil)) ;;_Если не наша команда, чистим список текущих слоев
;;;См http://forum.dwg.ru/showpost.php?p=318806&postcount=139
;;;и http://forum.dwg.ru/showpost.php?p=318806&postcount=143
    )
  (princ)) 
 ;;;------------------------------------------------------------- 
(defun cmd-end (calling-reactor cmd / cmd_name)
(setq cmd_name (strcase (car cmd)))
(if (or
      (wcmatch cmd_name "*HATCH*") ;_Если выполняется команда DIM*
      (wcmatch cmd_name "DIM*")    ;_Если выполняется команда *HATCH*
      (wcmatch cmd_name "*TEXT")   ;_Если выполняется команда *TEXT (TEXT DTEXT)
      (wcmatch cmd_name "*TABLE")   ;_Если выполняется команда ТАБЛИЦА
      (wcmatch cmd_name "*LEADER")   ;_Если выполняется команда *QLEADER или MLEADER
      )
  (progn
    (if *OldLayer* (setvar "clayer" *OldLayer*)) 
    (setq *OldLayer* nil)
    ))
 (princ))
***Добавлено 30.11.2008 Внесены изменения (красным) в соответствии с проблемой, описанной в #139 и решением #143

Автор Lee Mac. Опубликовано здесь (требуется регистрация)
Код:
[Выделить все]
;; Пояснения на русском добавлены VVA (Владимир Азарко)
;; Для активации / деактивации командных реакторов
;; необходимо набрать в командной строке LD
;;При аткивности реактора в строке MODEMACRO (левый нижний угол) будет надпись "LD+"
;;--------------------=={ Layer Director }==------------------;;
;;                                                            ;;
;;  Uses a command reactor to automatically set the layer     ;;
;;  upon the user invoking certain commands.                  ;;
;;                                                            ;;
;;  Layer settings are stored in the list at the top of the   ;;
;;  program. The first entry in the list is the command on    ;;
;;  which the reactor will trigger, it may use wildcards.     ;;
;;  The second entry is the designated layer for the command  ;;
;;  entered, this layer will be created if non-existent.      ;;
;;  The third entry is the layer colour that will be used if  ;;
;;  the layer is to be created in the drawing.                ;;
;;                                                            ;;
;;  The Reactor is set to be enabled upon loading the program ;;
;;  it can furthermore be toggled on and off using by typing  ;;
;;  'LD' at the command line.                                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;

(defun c:LD nil (LM:LayerDirector T))

(defun LM:LayerDirector ( msg )
  (vl-load-com)
  ;; © Lee Mac 2010

;;;;;;Здесь в виде списка задаем: команду, имя слоя, цвет
  (setq *LayerData*
   '(
     ("*TEXT"           "TEXT"       2) ;_ "*TEXT" - команда (DTEXT или MTEXT)
                                                ;_ "TEXT" - имя слоя
                                                ;_ 2 - цвет
     ("*DIM*,*LEADER"  "DIMENSIONS" 2)
     ("*VPORT*"         "DEFPOINTS"  7)
     ("*EXECUTETOOL"    "4"          4)
    )
  )
  ;;;

  (
    (lambda ( data callback1 callback2 / react )
      (if
        (setq react
          (vl-some
            (function
              (lambda ( reactor )
                (if (eq data (vlr-data reactor))
                  reactor
                )
              )
            )
            (cdar (vlr-reactors :vlr-command-reactor))
          )
        )
        (if (vlr-added-p react)
          (vlr-remove react)
          (vlr-add react)
        )
        (setq react
          (vlr-command-reactor data
            (list
              (cons :vlr-commandWillStart callback1)
              (cons :vlr-commandEnded     callback2)
              (cons :vlr-commandCancelled callback2)
            )
          )
        )
      )

      (if msg
        (if (and react (vlr-added-p react))
	  (progn
 	    (princ "\n<< Layer Director Enabled >>" )
	    (setvar
	      "Modemacro"
	      (strcat "LD+ "
		      (VL-STRING-LEFT-TRIM "LD+ " (getvar "modemacro"))
	      )
	    )
	    )
	  (progn
	    (princ "\n<< Layer Director Disabled >>")
	    (setvar
	      "Modemacro"
	       (VL-STRING-LEFT-TRIM "LD+ " (getvar "modemacro"))
	    )
	    )
        )
      )
    )

    "LayerDirector"
    'LayerDirectorSet
    'LayerDirectorReset
  )
  (princ)
)

(defun LM:MakeLayer ( name colour )
  (or (tblsearch "LAYER" name)
    (entmakex
      (list
        (cons 0   "LAYER")
        (cons 100 "AcDbSymbolTableRecord")
        (cons 100 "AcDbLayerTableRecord")
        (cons 2   name)
        (cons 62  colour)
        (cons 70  0)
      )
    )
  )
)

(defun LayerDirectorSet ( reactor arguments / layerdetails layer )
  (vl-load-com)
  ;; © Lee Mac 2010

  (if
    (and
      (setq layerdetails
        (vl-some
          (function
            (lambda ( x )
              (if (wcmatch (strcase (car arguments)) (car x))
                (cdr x)
              )
            )
          )
          *LayerData*
        )
      )
      (LM:MakeLayer (setq layer (car layerdetails)) (cadr layerdetails))
      (zerop
        (logand 1
          (cdr
            (assoc 70
              (tblsearch "LAYER" layer)
            )
          )
        )
      )
    )
    (progn
      (setq *oldlayer* (getvar 'CLAYER))      
      (setvar 'CLAYER layer)
    )
  )

  (princ)
)

(defun LayerDirectorReset ( reactor arguments )
  (vl-load-com)
  ;; © Lee Mac 2010

  (if
    (and (not (wcmatch (strcase (car arguments)) "*UNDO")) *oldlayer*
      (tblsearch "LAYER" *oldlayer*)
      (zerop
        (logand 1
          (cdr
            (assoc 70
              (tblsearch "LAYER" *oldlayer*)
            )
          )
        )
      )
    )
    (progn
      (setvar 'CLAYER *oldlayer*)
      (setq *oldlayer* nil)
    )
  )
  
  (princ)
)

(princ)
(LM:LayerDirector t)
(princ "\nДля активации / деактивации наберите в командной строке LD")

Последний раз редактировалось VVA, 21.10.2010 в 20:30. Причина: Новый вариант от Lee Mac
VVA вне форума  
 
Непрочитано 24.02.2006, 16:03
#26
getr

Конструктор
 
Регистрация: 06.04.2005
Из тех ворот-откуда весь народ.
Сообщений: 356
<phrase 1=


->VVA
Так быстро,-ну просто нет слов! Теперь все как хотелось.
С П А С И Б О !
getr вне форума  
 
Автор темы   Непрочитано 24.02.2006, 16:50
#27
Piton

Инженер строитель
 
Регистрация: 24.02.2005
Москва
Сообщений: 396


Еще раз спасибо Torino aka Кочетков Андрей ( :wink: ) и VVA
АДМИНИСТРАТОР РАЗДЕЛИ ТЕМУ НА 2-Е сам искал и не мог найти, нашел только через просмотр всех своих сообщений
Piton вне форума  
 
Непрочитано 24.02.2006, 19:20
#28
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


Хочу уточнить насчет авторства:
Впервые решение этой задачи мне показал Эдуард.
Потом я увидел аналогичную задачу у Kenny Ramage.
А мой код - очередная интерпретация идеи.

Последний раз редактировалось Кочетков Андрей, 31.03.2015 в 10:10.
Кочетков Андрей вне форума  
 
Непрочитано 24.02.2006, 22:52
#29
Dima

инженер
 
Регистрация: 30.08.2003
Одесса-Мама
Сообщений: 172
Отправить сообщение для Dima с помощью Skype™


Ну, господа, даёте! :shock:
Браво!
Примите и мое Спасибо!
Учиться учиться и еще раз учиться!!!
__________________
vinum
Dima вне форума  
 
Непрочитано 01.03.2006, 10:05
#30
getr

Конструктор
 
Регистрация: 06.04.2005
Из тех ворот-откуда весь народ.
Сообщений: 356
<phrase 1=


Поработал несколько дней и тут выявился один досадный момент.При наличии в автозагрузке этого файла невозможноустановить(через комстроку)текущим какой-либо слой посредством команды -Layer с опцией Set.Почему досадный?При наличии программ на Лиспе,употребляющих эту команду для установки текущего слоя перед отрисовкой чего-либо,отрисовка идет не на устанавливаемом слое,а на текущем перед выполнением лиспа.Просьба к знатокам Лиспа довести таки этот файл для автозагрузки,чтобы не было влияния на другие лисп-программы.
getr вне форума  
 
Непрочитано 01.03.2006, 11:16
#31
gadfly

конструктор
 
Регистрация: 28.02.2006
москва
Сообщений: 21


ИМХО. Лучше создать шаблон со всеми этими слоями, а не создавать их каждый раз при открытии. Чужие чертежи изменяются...
__________________
Кто не думает о конце, ошибется в начале.
gadfly вне форума  
 
Непрочитано 01.03.2006, 11:28
#32
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Вот как надо делать слои по-гурийски, чтобы не было заморочек с текущими установками:
Код:
[Выделить все]
(vl-load-com) 
  (setq lyrs (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'Layers)
        nlrs (mapcar '(lambda (x) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list lyrs x)));Проверяем наличие слоя в файле
              (vla-add lyrs x))) '("Dims" "Text" "Hatch")));Добавляем, если надо
  (foreach lyr nlrs
    (mapcar '(lambda (x y) (if (= (vla-get-name lyr) x) (vla-put-color lyr y)))
      '("Dims" "Text" "Hatch") '(151 6 5)));Присваиваем цвет ноывм слоям, а существующие - не трогаем
-----------------------------
Далее - реактор по-торински (что-то уж больно по кулинарному получилось)
Кроме указаных, можно добвлять в список слоев любые другие, так же, как и свойства и их значения в соотв. список.
Лентяй вне форума  
 
Непрочитано 01.03.2006, 12:16
#33
getr

Конструктор
 
Регистрация: 06.04.2005
Из тех ворот-откуда весь народ.
Сообщений: 356
<phrase 1=


->Лентяй
Не работает.Если нажать F12,то можно прочитать следующее:
AutoCAD menu utilities loaded.; error: bad argument type: VLA-OBJECT nil
Как быть?
getr вне форума  
 
Непрочитано 01.03.2006, 20:22
#34
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Странно, при загрузке моего фрагмента из VLISP-редактора все слои образуются, как надо. Проврерно на ACAD-2005 и АDТ-2005. А в каком именно мест у вас происходит сбой? Судя по сообщению об ошибке, объекты с примитивами, как обычно, "твоя моя не понимай".
Лентяй вне форума  
 
Непрочитано 01.03.2006, 23:13
#35
stim

просто ГИП.
 
Регистрация: 18.11.2005
Московская обл
Сообщений: 54
<phrase 1=


Даю простой совет. В опциях открываешь вкладку Files, в древе каталогов находишь Support File Search Path, копируешь путь (первая строка) у меня это
C:\Documents and Settings\1\Application Data\Autodesk\AutoCAD 2006\R16.2\enu\support
лезешь туда находишь файл acad.pjp, открываешь его блокнотом находишь команду break, через поиск, изменяешь первые буквы(у) в строке на любую другую(ие), но не трогай буквы после *, сохраняешь файл. Если надо вызвать команду вводишь с клавы эти буквы(у), а дальше выполняй действия согласно командной строки ( укажи т.1, укажи т.2)
Этот метод применяется к любой команде, и не надо рисовать макросы на лист.
Можешь заменить стандартный файл acad.pjp на мой и в Word посмотреть таблицу команд.
[ATTACH]1141244011.rar[/ATTACH]
__________________
Сергей Юрьевич
stim вне форума  
 
Непрочитано 01.03.2006, 23:16
#36
stim

просто ГИП.
 
Регистрация: 18.11.2005
Московская обл
Сообщений: 54
<phrase 1=


Вот acad.pjp и таблица команд
[ATTACH]1141244217.rar[/ATTACH]
__________________
Сергей Юрьевич
stim вне форума  
 
Непрочитано 02.03.2006, 01:49
#37
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


>getr
Разобрался. Проблема оказалась сугубо языковая в снысле, что имена слоев должны быть на одном языке. Ниже - англоязычный вариант.
Код:
[Выделить все]
(vl-load-com) 
  (setq lyrs (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'Layers) 
        nlrs (mapcar '(lambda (x) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list lyrs x)));Проверяем наличие слоя в файле 
              (vla-add lyrs x))) '("Dims" "Text" "Hatch")));Добавляем, если надо 
  (foreach lyr nlrs 
    (mapcar '(lambda (x y) (if (= (vla-get-name lyr) x) (vla-put-color lyr y))) 
      '("Dims" "Text" "Hatch") '(151 6 5)))
;
(vlr-command-reactor nil '((:vlr-commandWillStart . startCommand))) 
(vlr-command-reactor nil '((:vlr-commandEnded . endCommand))) 
(vlr-command-reactor nil '((:vlr-commandCancelled . endCommand))) 
;
(defun startCommand (calling-reactor startcommandInfo / thecommandstart)
  (setq thecommandstart (nth 0 startcommandInfo)) 
  (setq *OldLayer* (append *OldLayer* (list (getvar "CLAYER")))) 
  (cond ((wcmatch thecommandstart "DIM*") (setvar "clayer" "Dims"))
	((wcmatch thecommandstart "*HATCH*") (setvar "clayer" "Hatch"))
	((wcmatch thecommandstart "*TEXT") (setvar "clayer" "Text"))
	(t nil));cond 
  (princ)
);startCommand
;
(defun endCommand (calling-reactor endcommandInfo) 
 (if *OldLayer* (setvar "clayer" (nth 0 *OldLayer*))) 
 (setq *OldLayer* nil) 
 (princ) 
);endCommand
Лентяй вне форума  
 
Непрочитано 02.03.2006, 06:17
#38
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


> Лентяй
Цитата:
Проблема оказалась сугубо языковая в снысле, что имена слоев должны быть на одном языке.
Не в этом проблема. У меня тоже самое выдает:
Цитата:
error: bad argument type: VLA-OBJECT nil
Все слои названы одинаково. Если начинать работать с новым (чистым) файлом без заранее заданными слоями, тогда выдается та-же ошибка, но все работает и нужные слои создаются. Если использовать шаблон, где енти слои уже забиты, то не работает.
Krieger вне форума  
 
Непрочитано 02.03.2006, 10:36
#39
getr

Конструктор
 
Регистрация: 06.04.2005
Из тех ворот-откуда весь народ.
Сообщений: 356
<phrase 1=


->Лентяй
Ваш вариант работает при открытии нового файла.Но все равно оказывает влияние на работу лисп-программ,как писал выше.
При повторном открытии этого-же файла работать не хочет,выдает ту же ошибку "error: bad argument type: VLA-OBJECT nil ".
getr вне форума  
 
Непрочитано 02.03.2006, 11:25
#40
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


А теперь - после введения проверки на существоание измененного слоя?
Код:
[Выделить все]
(vl-load-com) 
  (setq lyrs (vlax-get (vla-get-activedocument (vlax-get-acad-object)) 'Layers) 
        nlrs (mapcar '(lambda (x) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list lyrs x)));Ïðîâåðÿåì íàëè÷èå ñëîÿ â ôàéëå 
              (vla-add lyrs x))) '("Dims" "Text" "Hatch")));Äîáàâëÿåì, åñëè íàäî 
  (foreach lyr nlrs 
    (if lyr (mapcar '(lambda (x y) (if (= (vla-get-name lyr) x) (vla-put-color lyr y))) 
      '("Dims" "Text" "Hatch") '(151 6 5))))
; 
(vlr-command-reactor nil '((:vlr-commandWillStart . startCommand))) 
(vlr-command-reactor nil '((:vlr-commandEnded . endCommand))) 
(vlr-command-reactor nil '((:vlr-commandCancelled . endCommand))) 
; 
(defun startCommand (calling-reactor startcommandInfo / thecommandstart) 
  (setq thecommandstart (nth 0 startcommandInfo)) 
  (setq *OldLayer* (append *OldLayer* (list (getvar "CLAYER")))) 
  (cond ((wcmatch thecommandstart "DIM*") (setvar "clayer" "Dims")) 
   ((wcmatch thecommandstart "*HATCH*") (setvar "clayer" "Hatch")) 
   ((wcmatch thecommandstart "*TEXT") (setvar "clayer" "Text")) 
   (t nil));cond 
  (princ) 
);startCommand 
; 
(defun endCommand (calling-reactor endcommandInfo) 
 (if *OldLayer* (setvar "clayer" (nth 0 *OldLayer*))) 
 (setq *OldLayer* nil) 
 (princ) 
);endCommand
Лентяй вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Автоматический перенос размеров на слой размеры. Break макро

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

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