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

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

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

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

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

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

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

Конструктор
 
Регистрация: 06.04.2005
Из тех ворот-откуда весь народ.
Сообщений: 332
Отправить сообщение для getr с помощью ICQ


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


 
Регистрация: 03.02.2006
Сообщений: 4,413


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

;;;Просто добавь этот файл в автозагрузку
(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,456
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для 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
Из тех ворот-откуда весь народ.
Сообщений: 332
Отправить сообщение для getr с помощью ICQ


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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,456
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для 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
Из тех ворот-откуда весь народ.
Сообщений: 332
Отправить сообщение для getr с помощью ICQ


->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
Кочетков Андрей


 
Регистрация: 03.02.2006
Сообщений: 4,413


Хочу уточнить насчет авторства:
Впервые решение этой задачи мне показал Эдуард.
Потом я увидел аналогичную задачу у 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
Из тех ворот-откуда весь народ.
Сообщений: 332
Отправить сообщение для getr с помощью ICQ


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

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


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

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


Вот как надо делать слои по-гурийски, чтобы не было заморочек с текущими установками:
Код:
[Выделить все]
(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
Из тех ворот-откуда весь народ.
Сообщений: 332
Отправить сообщение для getr с помощью ICQ


->Лентяй
Не работает.Если нажать 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,077


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

просто ГИП.
 
Регистрация: 18.11.2005
Московская обл
Сообщений: 54
Отправить сообщение для stim с помощью ICQ


Даю простой совет. В опциях открываешь вкладку 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
Отправить сообщение для stim с помощью ICQ


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

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


>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,546
Отправить сообщение для Krieger с помощью Skype™


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

Конструктор
 
Регистрация: 06.04.2005
Из тех ворот-откуда весь народ.
Сообщений: 332
Отправить сообщение для getr с помощью ICQ


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

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


А теперь - после введения проверки на существоание измененного слоя?
Код:
[Выделить все]
(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 макро

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

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

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

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


Размещение рекламы