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

Piton · 01.03.2005, 12:58

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

X-DeViL · 01.03.2005, 13:10

Код:

[Выделить все]

^C^C_break

С тебя пиво

Piton · 01.03.2005, 13:17

Не так, чтоб опцию first не надо было с клавы вводить

Lenich · 01.03.2005, 13:21

Код:

[Выделить все]

*^C^C_break \f \@

Списано со штатной кнопки кад 2002.

Piton · 01.03.2005, 13:31

догнал в 2005, надо так *^C^C_break \f; \@

Torino · 01.03.2005, 13:39

Если не в лайт версии, тогда можно так:
^C^C^P(defun c:break2 () (vl-cmdf "break" pause "f" pause pause)(princ))(c:break2)
Тогда будет работать повтор по правой правой кнопке.

Piton · 01.03.2005, 13:50

Torino, не работает-повтор просто команнда break (не LT у меня)

Torino · 01.03.2005, 13:53

Тогда вот так:

Код:

[Выделить все]

^C^C^P(defun c:break2 () (vl-cmdf "break" pause "f" pause pause)(princ));break2;

Piton · 01.03.2005, 14:09

Torino - кудесник, все ок
Есть еще вопрос
Для размеров пользуюсь макросом

Код:

[Выделить все]

^C^C_-layer;m;размеры;c;151;;;_DIMALIGNED;\\\_layerp

,но повтор по правой кнопке не срабатывает

Torino · 01.03.2005, 16:06

Код:

[Выделить все]

;;;Просто добавь этот файл в автозагрузку
(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 "" "") ;Да простят меня гуру...

(setvar "clayer" OldLayer)


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


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

  (if (wcmatch thecommandstart "DIM*")
    (setvar "clayer" "размеры")
  )


  (princ)
)


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

  (if
    (wcmatch thecommandend "DIM*")
     (setvar "clayer" OldLayer)
  )


  (princ)
)


(defun cancelCommand (calling-reactor
		      cancelcommandInfo
		      /
		      thecommandcancel
		     )
  (setq thecommandcancel (nth 0 cancelcommandInfo))

  (if
    (wcmatch thecommandcancel "DIM*")
     (setvar "clayer" OldLayer)
  )


  (princ)
)


(princ)

Piton · 01.03.2005, 18:50

Не срабатывает

Torino · 01.03.2005, 18:55

Что пишет?

plaz · 02.03.2005, 09:02

2Piton:

По поводу твоего макроса могу предложить поставить * в начале кода:

*^C^C_-layer;m;размеры;c;151;;;_DIMALIGNED;\\\_layerp

тогда и правая клавиша не нужна, единственное, выход только по ESC, и соответственно не возвращает на предыдущий слой

Piton · 02.03.2005, 09:51

При запуске пишет :
AutoCAD menu utilities loaded.layer
Current layer: "0"
Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/Plot/Freeze/Thaw/LOck/Unlock/stAte]:
m
Enter name for new layer (becomes the current layer) <0>: размеры Enter an
option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/Plot/Freeze/Thaw/LOck/Unlock/stAte]:
c
New color [Truecolor/COlorbook] : 151
Enter name list of layer(s) for color 151 <размеры>: Enter an option
[?/Make/Set/New/ON/OFF/Color/Ltype/LWeight/Plot/Freeze/Thaw/LOck/Unlock/stAte]:

Torino · 02.03.2005, 11:25

Все правильно. А теперь создай размер обычным способом и посмотри на каком слое он окажется.

Piton · 02.03.2005, 12:20

2 Torino Все ок. Просто я запускал команду через предыдущий макрос, а надо было запускать обычно без модиффикации

Piton · 02.03.2005, 13:53

2Torino Подскажи тогда и для штриховки

^C^C_-layer;m;ШТРИХОВКА;c;5;;;_bhatch;\\\_layerp

Torino · 03.03.2005, 13:55

Ну вот общими усилиями мы это сделали:

Код:

[Выделить все]

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


;;;Просто добавь этот файл в автозагрузку
(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 "" "")

(setvar "clayer" OldLayer)


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


(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" "штриховка")
    )
  )
;;;  (if (wcmatch thecommandstart "DIM*")
;;;    (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)
    )
  )




  (princ)
)


(defun cancelCommand (calling-reactor
		      cancelcommandInfo
		      /
		      thecommandcancel
		     )
  (setq thecommandcancel (nth 0 cancelcommandInfo))

  (cond
    ((wcmatch thecommandcancel "DIM*")
     (setvar "clayer" OldLayer)
    )
    ((wcmatch thecommandcancel "*HATCH*")
     (setvar "clayer" OldLayer)
    )
  )



  (princ)
)


(princ)

Torino · 03.03.2005, 14:14

Или лучше так:

Код:

[Выделить все]

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

;;;Просто добавь этот файл в автозагрузку
(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 "" "")
(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" "штриховка")
    )
  )
  (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)
    )
  )
  (princ)
)

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

(princ)

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

Piton · 03.03.2005, 14:33

2Torino СУПЕР об этом мечтал 2 года 8)

getr · 24.02.2006, 11:00

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

Кочетков Андрей · 24.02.2006, 12:54

Код:

[Выделить все]

;;;Автоматический перенос размеров на слой "размеры",
;;;заливки на слой "заливка" и  текста на слой "текст"

;;;Просто добавь этот файл в автозагрузку
(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)

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

VVA · 24.02.2006, 13:39

Позволю себе несколько модернизировать текст. При вызове команды идет вызов реакторов несколько раз и 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))

getr · 24.02.2006, 14:28

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

VVA · 24.02.2006, 15:01

Код:

[Выделить все]

;;; Автор идеи 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")

getr · 24.02.2006, 16:03

->VVA
Так быстро,-ну просто нет слов! Теперь все как хотелось.
С П А С И Б О !

Piton · 24.02.2006, 16:50

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

Кочетков Андрей · 24.02.2006, 19:20

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

Dima · 24.02.2006, 22:52

Ну, господа, даёте! :shock:
Браво!
Примите и мое Спасибо!
Учиться учиться и еще раз учиться!!!

getr · 01.03.2006, 10:05

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

gadfly · 01.03.2006, 11:16

ИМХО. Лучше создать шаблон со всеми этими слоями, а не создавать их каждый раз при открытии. Чужие чертежи изменяются...

Лентяй · 01.03.2006, 11:28

Вот как надо делать слои по-гурийски, чтобы не было заморочек с текущими установками:

Код:

[Выделить все]

(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)));Присваиваем цвет ноывм слоям, а существующие - не трогаем
-----------------------------
Далее - реактор по-торински (что-то уж больно по кулинарному получилось)

Кроме указаных, можно добвлять в список слоев любые другие, так же, как и свойства и их значения в соотв. список.

getr · 01.03.2006, 12:16

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

Лентяй · 01.03.2006, 20:22

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

stim · 01.03.2006, 23:13

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

Вот acad.pjp и таблица команд
[ATTACH]1141244217.rar[/ATTACH]

Лентяй · 02.03.2006, 01:49

>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

Krieger · 02.03.2006, 06:17

> Лентяй

Цитата:

Проблема оказалась сугубо языковая в снысле, что имена слоев должны быть на одном языке.

Не в этом проблема. У меня тоже самое выдает:

Цитата:

error: bad argument type: VLA-OBJECT nil

Все слои названы одинаково. Если начинать работать с новым (чистым) файлом без заранее заданными слоями, тогда выдается та-же ошибка, но все работает и нужные слои создаются. Если использовать шаблон, где енти слои уже забиты, то не работает.

getr · 02.03.2006, 10:36

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

Лентяй · 02.03.2006, 11:25

А теперь - после введения проверки на существоание измененного слоя?

Код:

[Выделить все]

(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

getr · 02.03.2006, 14:02

->Лентяй
Теперь сообщения об ошибке нет.Работает как и вариант VVA+Кочетков.Но влияние на работу других лиспов осталось.

Лентяй · 02.03.2006, 21:19

Подробнее, плз! Какое "влияние", какие лиспы, совпадают ли имена переменных м т.д. Потому как в конкретных условиях возможно все, что угодно.

Krieger · 03.03.2006, 07:34

> Лентяй

Цитата:

невозможноустановить(через комстроку)текущим какой-либо слой посредством команды -Layer с опцией Set.

Ни set ни make не срабатывают, т.е. даже такой макрос (был в начале темы)

Код:

[Выделить все]

^C^C_-layer;m;размеры;c;151;;;_DIMALIGNED;\\\_layerp

работать не будет

getr · 03.03.2006, 10:09

Да.именно об этом идет речь.Если в лиспах применяется -Layer с опциями Set или Make (или (vl-cmdf "_'layer" "_S" "Осевые")),то эти команды не выполняются.Отрисовка идет на текущем слое.

Кулик Алексей aka kpblc · 03.03.2006, 11:07

А если такое попробовать?

Код:

[Выделить все]

(if (not *kpblc-activedoc*)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of if

(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-cancel)
		      (:vlr-commandfailed . cmd-fail)
		      )
		    ) ;_ end of VLR-Command-Reactor
	) ;_ end of setq
  ) ;_ end of if
;; Функция подгрузки типа линии - на http://www.autocad.ru/cgi-bin/f1/board.cgi?t=22730iW

;|=============================================================================
*    Создание слоя с указанными параметрами.
*    Параметры вызова:
*	layer-list	список параметров слоя вида:
	'(("name" . "TestLayer")	; имя слоя. Не может быть пропущено
	("color" . 3)			; номер цвета. nil -> 7
	("lw" . 50)			; вес линии слоя. nil -> 25
	("lt" . "hidden")		; тип линии слоя. nil -> Continuous
					; Если описания типа линии в acadiso.lin
					; нет, обязательно указывать следующий
					; параметр
	("ltfile" . "c:\\cad\\ltypes\\lt.lin")	; полный путь к файлу с описанием
					; типа линии. Если файл находится в путях
					; поддержки, путь можно не указывать
	("plot" . "y")			; Печатать ("y") или нет ("n") слой.
					; nil -> "y"
	)
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*    Слой размораживается, разблокируется и включается. Не активируется.
|;
(defun _kpblc-layer-create (layer-list / vla_layer)
  (setq	vla_layer
	 (vla-add
	   (vla-get-layers *kpblc-activedoc*)
	   (cdr (assoc "name" layer-list))
	   ) ;_ end of vla-add
	) ;_ end of setq
  (vla-put-color
    vla_layer
    (if	(cdr (assoc "color" layer-list))
      (cdr (assoc "color" layer-list))
      7
      ) ;_ end of if
    ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if	(cdr (assoc "lw" layer-list))
      (cdr (assoc "lw" layer-list))
      aclnwt025
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (cdr (assoc "lt" layer-list))
	   (_kpblc-linetype-load
	     (cdr (assoc "lt" layer-list))
	     (cdr (assoc "ltfile" layer-list))
	     ) ;_ end of _kpblc-linetype-load
	   ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if	(= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer *kpblc-activedoc*)
		  vla_layer
		  ) ;_ end of equal
	   ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun

(defun cmd-start (react	   cmd	    /	     selset   cmd_name ent
		  svr	   res	    tag	     text     index    _attreq_
		  _attdia_
		  )
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((vl-string-search "dim" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "Размеры")
	   ("color" . 2)
	   ("lw" . 25)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ((vl-string-search "hatch" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "Штриховки")
	   ("color" . 3)
	   ("lw" . 00)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ((vl-string-search "text" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "Тексты")
	   ("color" . 6)
	   ("lw" . 25)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-end (react	     cmd	  /	       list_obj
		selset	     item	  counter      leader_item
		cmd_name     leader_item_list	       up_string
		low_string
		)
  (setq	cmd_name (strcase cmd_name t)
	counter	 0
	) ;_ end of setq
  (cond
    ((or (vl-string-search "dim" cmd_name)
	 (vl-string-search "text" cmd_name)
	 (vl-string-search "hatch" cmd_name)
	 ) ;_ end of or
     (if *vlr-settings*
       (progn
	 (vla-put-activelayer
	   *kpblc-activedoc*
	   (cdr (assoc "layer" *vlr-settings*))
	   ) ;_ end of vla-put-ActiveLayer
	 (mapcar 'setvar
		 '("cecolor" "celweight" "celtype")
		 (list (cdr (assoc "color" *vlr-settings*))
		       (cdr (assoc "lw" *vlr-settings*))
		       (cdr (assoc "lt" *vlr-settings*))
		       ) ;_ end of list
		 ) ;_ end of mapcar
	 (setq *vlr-settings* nil)
	 ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-cancel (react cmd / cmd_name)
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((or (vl-string-search "dim" cmd_name)
	 (vl-string-search "text" cmd_name)
	 (vl-string-search "hatch" cmd_name)
	 ) ;_ end of or
     (if *vlr-settings*
       (progn
	 (vla-put-activelayer
	   *kpblc-activedoc*
	   (cdr (assoc "layer" *vlr-settings*))
	   ) ;_ end of vla-put-ActiveLayer
	 (mapcar 'setvar
		 '("cecolor" "celweight" "celtype")
		 (list (cdr (assoc "color" *vlr-settings*))
		       (cdr (assoc "lw" *vlr-settings*))
		       (cdr (assoc "lt" *vlr-settings*))
		       ) ;_ end of list
		 ) ;_ end of mapcar
	 (setq *vlr-settings* nil)
	 ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

Я четко понимаю, что на меня сейчас накинутся, что "функцию дополнительную можно было бы вколотить", что "указывать надо весь код, а не раскидывать его по просторам инета" и т.д.
Говорю сразу - писалось "на коленке". Со всеми вытекающими.

getr · 03.03.2006, 11:51

Попробывал,получил следующее:при загрузке-Command: _appload ; error: bad argument type: stringp nil,
проигнорировав и при попыке проставить размер-
Command: _dimradius ; error: no function definition: VLA-PUT-00000

Select arc or circle:
Dimension text = 24.5
Specify dimension line location or [Mtext/Text/Angle]: ; error: bad argument
type: stringp nil

Кулик Алексей aka kpblc · 03.03.2006, 12:03

1. Функцию подгрузки типа линии закинул? Ссылка: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=22730iW
2. Почему-то в коде после копирования вместо vla-put-freеze получилось vla-put-00000.
В общем, чтоб не было мучительно больно - см. приложение.
[ATTACH]1141376632.rar[/ATTACH]

getr · 03.03.2006, 14:10

Пусть будет сначала "мучительно больно",главное чтобы потом было приятно.

Попробовал еще раз-на первый взгляд все отлично,но надо бы поработать подольше,-вдруг вылезет какая-нито бяка.Но внутренний голос говорит,что все нормалек.Спасибо,kpblc!!!
P.S.Видимо незря ник-крыс,-крысы они очень умные животные.Даже по гороскопу есть умные крысы(напр.рожденные в 1960году).Не удержался и подольстился.Уж очень хотелось,чтобы эта идея с распределением по слоям нашла реальное решение.

Кулик Алексей aka kpblc · 03.03.2006, 14:18

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

getr · 03.03.2006, 15:05

Насчет доделать-это уже сложнее.О лиспе у меня лишь самые элементарные понятия.Вот заметил,как мне кажется,очепятку там где настраивается слой штриховки:LW стоит 00,а япоставил 20,-и то уже хорошо.А вот зачем подгружать линии я не понимаю,ведь и размеры и текст и штриховка испоьзует Continuous,но раз надо так надо.А насчет того,что мало отслеживается команд,для меня это основные и пока хватит надолго.Спасибо еще раз.

Кулик Алексей aka kpblc · 03.03.2006, 15:33

Ну вот захотелось мне показать такой вариант, это просто левая пятка не вовремя зачесалась

Насчет команд - смотри, а если, допустим, ты все рисуешь полилиниями, а отрезками - осевые? Тогда на команду "line" (это полное имя команды) создаешь новый слой с подгрузкой типа линии center из текущего lin-файла.

Valuta · 03.03.2006, 16:27

Спасибо создателям и всем, приложившим руку, от наших теток за возможность не думая, раскидывать размеры и штриховку в нужный слой... :!:
Пищат от восторга...
(Жаль только с текстом не совсем подходит...)

Кулик Алексей aka kpblc · 03.03.2006, 16:32

А что такого с текстом не проходит?

pyatifan · 05.03.2006, 17:15

От меня тож спасибо...уверен наши тётьки тож будут рады, да и самому пригодится. Самый успешный вариант в 47 посте. Загрузил файл и вырезал оттуда код про линии, ато 2 инструмента в одном получается. Проблемы getr у меня нет, т.к. лиспов, использующих свои установленные слои в моей коллекции нет.

>kpblc, этот код к линиям наверняка хорош, но у меня не получается им воспользоваться в полной мере. Тока типа таких линий (_kpblc-linetype-load "center" nil) и грузит из файла acadiso.lin Если не трудно расскажи поподробнее как фигануть линии из своего файла; в поддержку я его положил. Вообще была идея пользоваться макросом типа "^C^C-linetype s имя_лини", но линии должны быть уже подгружены в чертёж. И вообще такой макрос фигня, т.к. бывает нужна тока пара тройка линий сварки из десятка. Есть идея сделать вариант выбора линии: типа если линия есть в чертеже, то вставить-если нет в чертеже, то подгрузить. А каждый раз тянуться за ними как в слои для размеров к примеру тож не хоца.

на том сайте сложности с регистрацией...

Кулик Алексей aka kpblc · 06.03.2006, 10:16

> pyatifan : На каком сайте сложности с регистрацией?
Так, насчет линий. Например, есть файлы defined.lin и defined.sh*, лежащие в одном месте. К примеру, у тебя там болтается описание типа линии "ГП-КранПуть" (имя от балды взял). Тогда вызвать функцию для подгрузки типа линии можно так:
(_kpblc-linetype-load "ГП-КранПуть" "defined.lin")
В качестве внутреннего списка (который лежит внутри определения функции) можно не прописывать пары соответствия для английской и русской версий - имена-то одинаковые.

getr · 06.03.2006, 10:17

->kpblc
Насчет реакции на команду Line,-врядли это удобно.Если например надо начертить штриховую,то она тогда тоже окажется на слое осевых.А вот если будет программа реагировать на тип выбираемой линии из Linetype Control и разносить послоям,тогда есть смысл.Выбрал штриховую,начертил ее с помощью Line или PLine,-легла в свой слой;выбрал сварку,-также легла куда надо(но тут уже надо будет реакция на несколько типов линий).Программа усложнится и вряд ли захочется (или найдется время) ее усовершенствовать.Но уже на этом этапе,как показывают отзывы,народ доволен и даже очень.Впрочем как и я.

Кулик Алексей aka kpblc · 06.03.2006, 10:33

> getr : Ну я ж так, для примеру... На самом деле смотри - можно поставить реактор на начало команды сохранения (SAVE, QSAVE) - с выполнением полной чистки чертежа, например. И назначения всем примитивам одного текстового и размерного стиля, к примеру.
На DWGPROPS - вызов собстсвенного окна, к примеру. Да мало ли что можно сделать...
А насчет линии на свой слой тут имхо проще надо сделать - делаем слой, запоминаем текущие установки, делаем свой слой со своим типом линии, цветом и весом; рисуем; возвращаем все обратно.
Такие вещи проще всего повесить в отдельный лисп, а инструмент закинуть на toolpalette (ЯТД). И множить инструменты, меняя 1-2-3 входных параметра. Естественно, что требуется дополнительно прописывать обработчик ошибок, назначать его и прочая.

pyatifan · 06.03.2006, 22:02

Клёво. Спасиб

И чё я сразу не догадался...в файле вроде чёрным по-белому написано (defun _kpblc-linetype-load
(ltype-name ltype-file
Соответствие наименований линий как я понял это замена на русские названия линий в файле, но не получается:
(_kpblc-linetype-load "скрытая" nil)
выводит nil, но это в принципе не особо страшно, т.к. всё равно на кнопке что угодно можно фигануть.
Я всётаки хотел довести ету идею до ума...т.е. пока получается мне нужно совершить 2 действия:
-загрузить линию из файла в чертёж (за что ещё раз спасибо),
-и вставить её в чертёж глупым макросом;
Хотелось бы одним щелчком, не знаю как грамотно дописать это всё...т.е. эхо вывод фигануть и т.п. да и lisp пока для меня не початый край.
Как ни крути, одна фигня за лисп садиться надо

Кулик Алексей aka kpblc · 07.03.2006, 09:38

> pyatifan : А в acadiso.lin есть описание линии "скрытая"? Если нет, то в качестве второго параметра передавай имя lin-файла с описанием этого типа линии.
Теперь насчет остального. Как пример. Пишу на коленке, т.к. работы много. За корявость прошу не судить особо строго.

Код:

[Выделить все]

;|=============================================================================
*    Функция рисования полилинии по точкам, указанным пользователем.
*    Параметры вызова:
*	param-list	список точечных пар вида
*			'("name" . "LayerName")	; имя слоя, на котором рисуется
*						; полилиния. Если слоя нет, он
*						; создается. Если слой есть,
*						; выполняются его настройки
*						; слой размораживается
*			("color" . 3)		; цвет слоя. nil -> 7
*			("lt" . "hidden")	; тип линии слоя. nil -> Continuous
*			("ltfile" . "defined.lin")	; имя файла с определением
*						; типа линии. nil -> acadiso.lin
*			("lw" . aclnwt050)	; вес линии слоя. nil 0> aclnwt025
*		)
*    Если один из параметров пропущен, он устанавливается в текущее значение.
*    Недостающие функции можно взять, например, здесь:
* http://www.arcada.com.ua/forum/viewtopic.php?t=445
=============================================================================|;
(defun _kpblc-draw-pline (param-list / adoc *error* layer_list)
  (vl-load-com)
  (setq	adoc	(vla-get-activedocument (vlax-get-acad-object))
	*error*	kpblc-error
	) ;_ end of setq
  (vla-startundomark adoc)
  (if (assoc "layer" param-list)
    (progn
      (setq layer_list (cdr (assoc "layer" param-list)))
					; сделано для собственного удобства.
					; Многим не понравится :)
      (kpblc-error-save-sysvar
	(list (list "clayer"
		    (if	(cdr (assoc "name" layer_list))
		      (vla-get-name (_kpblc-layer-create layer_list))
		      (getvar "clayer")
		      ) ;_ end of if
		    ) ;_ end of list
	      (list "cecolor"
		    (if	(cdr (assoc "color" layer_list))
		      (vla-get-color (_kpblc-layer-create layer_list))
		      (getvar "cecolor")
		      ) ;_ end of if
		    ) ;_ end of list
	      (list "celtype"
		    (if	(cdr (assoc "lt" layer_list))
		      (vla-get-linetype (_kpblc-layer-create layer_list))
		      (getvar "celtype")
		      ) ;_ end of if
		    ) ;_ end of list
;;; Ну и так далее. Просто не пишу, поскольку со временем напряг.
	      ) ;_ end of list
	) ;_ end of kpblc-error-save-sysvar
      ) ;_ end of progn
    ) ;_ end of if
  (command "_.pline")
  (while (/= (logand (getvar "cmdactive") 31) 0)
    (command pause)
    ) ;_ end of while
  (kpblc-error-restore-sysvar)
  (vla-endundomark adoc)
  ) ;_ end of defun

Обрати внимание, что параметры вызова функции этой и функции _kpblc-layer-create совпадают! Без этого нормальной работы так легко будет уже не добиться.
Теперь собственно вкусности: макрос на выполнение:

Код:

[Выделить все]

^C^C(defun c:m-pline() (_kpblc-draw-pline '(("name" . "Скрытые") ("color" . 4) ("lt" . "Скрытые") ("ltfile" . "c:\\cad\\adds\\defined.linЭ))));m-pline;
Пишу в запарке и мыле, так что если что не сработает, обязательно сообщи, попробую исправить (код проверять на полную работоспособность нет времени совсем :().

SkiFF · 12.03.2006, 16:29

Из 25-го сообщения

Цитата:

Сообщение от VVA

[code];;; Автор идеи Torino, он же Кочетков Андрей
;;;Автоматический перенос размеров на слой "размеры"
;;;и заливки на слой "заливка"
................................................................

Не могу понять. При установки лиспа в автозагрузку отключается команда UNDO. Вернее отмена происходит только один раз. Изменение установок команды UNDO к результату не приводит. Только удаление из автозагрузки лиспа востанавливает положение дел. Что делать? лисп то хороший.

Серёга - Bilder · 12.03.2006, 17:19

Люди, я в LISPе полный 0, но почитав тут Ваши посты меня заинтересовала тема... Посоветуйте, что почитать можно по LISPу для просвещения и возможно практического применения?

Ещё вопрос: т.к. я всегда работаю с одним набором слоёв, стилями текста и размеров - возможно-ли сделать как-нибудь чтоб автоматически при создани нового файла там создавались требуемые стили текста и размеров, ну и слои разумеется? - если не сложно, объясните мне-чайнику (ох губищи-то я раскатал

)

Aragorn · 12.03.2006, 20:12

Если совсе просто, то без знания лиспа можно сделать блок, в котором есть все необходимые слои, занести его на tool pallete и при создании чертежа просто вставлять его. (Ну это если совсем просто)
[ATTACH]1142183579.dwg[/ATTACH]

Серёга - Bilder · 12.03.2006, 20:17

Ну в том-то и дело, что сейчас я так и поступаю... а всё-таки охота быть не совсем чайником

Если не сложно - объясните что к чему

Кочетков Андрей · 13.03.2006, 08:38

>>Серёга - Bilder
Если совсем просто, то надо создавать чертеж из шаблона с предустановленными параметрами

А на тему изучения Лиспа уже было. Поищи.
Примерные названия тем: "Литература по Лиспу", "Начинаю изучать Лисп" и т.д.

Valuta · 13.03.2006, 08:48

Для 2004 - "Undo" работает на последнюю коменду, а в 2005-2006 - все нормально....
И при выходе из AutoCADa, даже если save давил, все равно запрашивает о сохранении файла...

Valuta · 13.03.2006, 08:50

Цитата:

Сообщение от kpblc

А что такого с текстом не проходит?

Просто слоев с тексом порядка 3 штук....

Кулик Алексей aka kpblc · 13.03.2006, 09:06

Хе, так там тогда в коде надо снимать обработку команды *text - чтоб на это дело не реагировало.

VVA · 13.03.2006, 10:47

>SkiFF №60
>Valuta

Цитата:

Для 2004 - "Undo" работает на последнюю коменду, а в 2005-2006 - все нормально....

Похоже, что это глюк 2004. Т.к. в 2002, 2005-2006 все нормальню.
>SkiFF №60 Или мириться, или менять версию...
ЗЫ Причем слет команды UNDO получается на этот код

Цитата:

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

ЗЫЗЫ Пока экспериментировал лисп с №47 начал работать. Undo в 2004 отменяется [sm2100]

Valuta · 13.03.2006, 10:52

Цитата:

Сообщение от kpblc

Хе, так там тогда в коде надо снимать обработку команды *text - чтоб на это дело не реагировало.

Пришлось так сделать...А в остальном - очь-очь хорошо

Кулик Алексей aka kpblc · 13.03.2006, 10:54

Ну народ, я ж писал под конкретную задачу...
> VVA : А это на моем коде было? В смысле - некорректная обработка окончания команды? Или там несколько реакторов было, и они между собой все договориться не могли?

VVA · 13.03.2006, 11:24

>kpblc В 2004 при использовании лиспа №25 слетает UNDOCTL в 1, причем если закоментарить (vlr-command-reactor nil '((:vlr-commandEnded . endCommand))), то все нормально. Я когда убедился, закрыл документ с загруженным №25 (не автокад), открыл новый, загрузил №47 - точно также. Возможно, надо было закрыть Acad. Т.к. потом у меня №47 отрабатывает без проблем.

Кулик Алексей aka kpblc · 13.03.2006, 11:53

На уровне предположения - мои функции обрабатывают одни и те же команды, что и прописывается внутри. У тебя же - все вместе. Попробуй в своих дополнительную проверку поставить на выполняемые команды.
А вообще-то UNDOCTL, судя по документации, read-only, так что каким таким манером оно поменялось, до меня не доходит.

VVA · 13.03.2006, 13:29

>SkiFF №60 Подправил лисп в посте №25. Теперь UNDO в 2004 должно отрабатывать по полной программе (по крайней мере у меня работает)
>kpblc и всем кому интересно, этот глюк происходил, если в ф-ции, отрабатывающей на окончание команды слой восстанавливался без анализа имени команды, а при налии глобальной переменной.
Как только вставил if и проверку на имя команды все заработало :evil: Ты был прав [sm206]

Цитата:

(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)
))

Valuta · 31.03.2006, 08:53

Еще один нюансик при автопереносе размеров в свой слой: при выполнении команды "qdim"(быстрый размер) вся размерная цепочка помещается в текущий слой, а хотелось, чтобы в нужный...

Кулик Алексей aka kpblc · 31.03.2006, 09:18

Для какого кода не срабатывает? Только что специально проверил код из №47, все нормально проходит, даже на пустом файле

Лентяй · 31.03.2006, 10:17

>kpblc,
Я тут с вашей подачи начал баловаться реакторами и добаловался до интересной задачки. Требуется перевести блок, имя которого входит в заранее определенный список на специфический слой, определяемый другим примитивом, с котоым этот блок обретает общую точку. Проблема - в идетнификации последнего измененного объекта. Если блок вставляется insert-ом или копируется - проблем нет, потому как entlast [sm154]. А вот если он просто передвинут (move) или использован для удлинения/обрезания линии, то тады ой [sm2100]. Короче - люди добрые [sm1400].

Кулик Алексей aka kpblc · 31.03.2006, 10:23

Может быть, попробовать (vla-pickfirstselectionset) - он же хранит в себе выделенные объекты?
И я не очень понял необходимости применения именно реакторов для такой задачи. Хотя... Если на команды _.move, _.copy, _.insert повесить, то можно и использовать. А вставку блока все одно производить можно выполнять лиспом и сразу на него давать все необходимое. Я бы, по крайней мере, так поступал.
---
P.S. Хм, кажется, я начинаю клонироваться - меня становится много

Лентяй · 31.03.2006, 11:02

[quote="kpblc"]Может быть, попробовать (vla-pickfirstselectionset) - он же хранит в себе выделенные объекты?
Мерси, завтра попробую.

Цитата:

И я не очень понял необходимости применения именно реакторов для такой задачи. Хотя... Если на команды _.move, _.copy, _.insert повесить, то можно и использовать.

А еще "TRIM" и "EXTEND".

Цитата:

А вставку блока все одно производить можно выполнять лиспом и сразу на него давать все необходимое. Я бы, по крайней мере, так поступал.

Ответы на простые вопросы я знаю сам

---

Цитата:

P.S. Хм, кажется, я начинаю клонироваться - меня становится много

Хорошего человекв должно быть много [sm155]

Кулик Алексей aka kpblc · 31.03.2006, 11:12

Цитата:

Сообщение от Лентяй

Ответы на простые вопросы я знаю сам

Я не сумлеваюсь ни единой секунды. И не только на простые, я полагаю, а?

wolt · 15.11.2006, 09:19

А каким образом добавить вес линии вот в такую команду?
(vl-cmdf "_layer" "_make" "ШТРИХОВКА" "_color" 50 "" "") ;_Создаем слой и задаем цвет 50

Кулик Алексей aka kpblc · 15.11.2006, 09:29

Вес линии для слоя? Или установить celweight?

Krieger · 15.11.2006, 09:37

wolt

Код:

[Выделить все]

(vl-cmdf "_layer" "_make" "ШТРИХОВКА" "_color" 50 "" "LWeight" 0.25 "" "")

wolt · 15.11.2006, 09:41

Цитата:

Сообщение от Krieger

wolt

Код:

[Выделить все]

(vl-cmdf "_layer" "_make" "ШТРИХОВКА" "_color" 50 "" "LWeight" 0.25 "" "")

Открыл автокад -руганулся при создании файла
Говорит:"Неправильное ключевое слово."

Автокад с официальной русской локализацией

Понял почему, надо подчёркивание добавить: "_LWeight" 0.25 тогда не ругается

Большое спасибо!

wolt · 15.11.2006, 09:43

Цитата:

Сообщение от kpblc

Вес линии для слоя? Или установить celweight?

Да, наверно вес линии, чтобы при создании он был не "Обычный", а например толщиной 0.13

Кулик Алексей aka kpblc · 15.11.2006, 10:06

> wolt : ты пожалуйста, не обижайся, но диалог наш с тобой выглядит примерно:

Цитата:

"Как писать - так или так?"
"Да!"

Вес линии должен быть на слой установлен? Тогда рецепт от Krieger. Вес линии для новых объектов должен быть назначен, независимо от слоя? Тогда играйся с celweight.

wolt · 15.11.2006, 10:16

Цитата:

Сообщение от kpblc

> wolt : ты пожалуйста, не обижайся, но диалог наш с тобой выглядит примерно:

Цитата:

"Как писать - так или так?"
"Да!"

Вес линии для новых объектов должен быть назначен, независимо от слоя? Тогда играйся с celweight.

О как, просто не знал что и так можно... Ну а про то, что не очень понятно ответил... я просто не знаю за что отвечает команда celweight.

Кулик Алексей aka kpblc · 15.11.2006, 10:21

Из справки:

Цитата:

CELWEIGHT Системная переменная
Тип: целый
Сохранен в: рисунок
Начальное значение: -1
Установка вес линий для новых объектов. .
-1 Установка значения "ПОСЛОЮ" для веса линий.
-2 Установка значения "ПОБЛОКУ" для веса линий.
-3 Установка значения "ОБЫЧНЫЙ" для веса линий. Значение веса "ОБЫЧНЫЙ" контролируется системной переменной LWDEFAULT.
Другие допустимые значения 0, 5, 9, 13, 15, 18, 20, 25, 30, 35, 40, 50, 53, 60, 70, 80, 90, 100, 106, 120, 140, 158, 200 и 211.
Значения выражаются в сотых долях миллиметра. Для преобразования веса линий, выраженного в британской системе единиц, необходимо умножить его значение на коэффициент 2.54.

wolt · 15.11.2006, 10:26

Цитата:

Сообщение от kpblc

Из справки:

Цитата:

CELWEIGHT Системная переменная .....

Спасиба.

СерJант · 16.10.2007, 15:23

Всем здрасте. Спасибо за вашу работу, очень классно!!!! Особое спасибо за посты 23 и 25!
Не совсем понял вот эту концовку:

(wcmatch cmd_name "*HATCH*") ;_Если выполнается команда DIM*
(wcmatch cmd_name "DIM*") ;_Если выполнается команда *HATCH*
(wcmatch cmd_name "*TEXT") ;_Если выполнается команда *TEXT (TEXT DTEXT)

Почему такое следование, HATCH когда выполнается команда DIM
DIM Если выполнается команда *HATCH*

Со звездочками разобрался

Еще вопрос! Можноли назначать теже функции, настройки по слоям на кнопки СПДС и Прожект Студио? Наблидается некоторая несовместимость Прожект Студио с СПДС, можноли програмными методами убрать это, т.е может кто нибудь написать лисп, а именно что хотелосьбы,
1. убрать панель масштаба Прожект студио, чтобы не просто вид его пропал а просто убрять его функционал. Чтобы масштаб использовался только СПДСный.
2. Убрать размерные стили Прожекта полностью, чтобы все размерные стили использовались от СПДС
3. Отключить в Прожекте функцию округления десятичных значение, т.е. по умолчанию в Автокаде стоит четыре нуля после запятой, а прожек показывает только целочисленные значения

Сие дело возможно реализовать???

VVA · 16.10.2007, 16:24

по п.1 просто перепутаны коментарии
Сию конструкцию

Код:

[Выделить все]

(or
      (wcmatch cmd_name "*HATCH*") ;_Если выполнается команда *HATCH*
      (wcmatch cmd_name "DIM*")    ;_Если выполнается команда DIM
      (wcmatch cmd_name "*TEXT")   ;_Если выполнается команда *TEXT (TEXT DTEXT) 
      )

Можно заменить

Код:

[Выделить все]

(wcmatch cmd_name "*HATCH*,DIM*,*TEXT")

СерJант · 19.10.2007, 11:30

Ребят а если использовать в качестве изменения типа линий команду _LineType
Что нибудь можно придумать, а то ког больно сложный , не разобрался.
Пробовал прописать в код из поста №45 _LineType, не чего не получилось , пишет ошибку, помогите пожалуста.

nazarkoo · 07.11.2007, 10:01

Я полный "0" в LISPе. Пожалуйста разьясните по шагово как ето зделать. (Что куда записать, что как открыть)
Заранее очень благодарный.

Кулик Алексей aka kpblc · 07.11.2007, 10:26

dwg.ru/art/8

nazarkoo · 08.11.2007, 08:40

>Кулик Алексей aka kpblc : Очень благодарный!!!

nazarkoo · 09.11.2007, 09:08

Подскажите как можна к даному LISPу подключить команди и функции СПДС.

andrew_ro · 12.09.2008, 15:32

Здравствуйте.
Я давно пользуюсь лиспом из #47, за что огромное спасибо его содателям. Как то в инете нашел похожий лисп и вот решил поднять старую тему. В этом лиспе есть некоторые полезные функции, которые не реализованы в программе kpblcа, а так хотелось бы их иметь. Например перенос автокадовской выноски на слой Dim2. Проблема только в том, что этот липс создает слои с англ. названиями и типом линий по умолчанию. Что бы не плодить новые слои в старых чертежах хотелось бы иметь возможность изменить настройки слоя: цвет, вес линий, название слоя. Пробывал просто переписать в тексте программы название слоя (в лиспе из #47 это проходит) - автокад выводит на экран палитру цветов и просит указать цвет, только после этого лисп начинает работать. Вопрос: как изменить код чтобы можно было менять настройки создаваемых слоев. Подозреваю, что придется править (или создать новый) файл VRL-Manager.fas, но как - я не знаю.
В принципе, можно добавить эти функции (перенос выноски, видовых экранов и маркера центра на свои слои) из этого лиспа в код kpblса, отличная программа получится.

Красин · 12.09.2008, 19:05

Я не думаю, что тут нужно программирование и всякие там замороченые реакторы.
Для таких целей применяйте Tool Palettes (инструментальные палитры)
Я все графические примитивы, блоки и размеры и почти все лиспы ввожу с Tool Palettes (окно инструментальных палитр CRL+3). Можно задать все свойства: от слоя до динамических свойств динамических блоков. Начните копировать и вставлять инструменты с палитры под названием "инструменты-команды" (command tools). Там имеется рисовальные команды меню "рисование", штриховки, таблица, размеры и даже выражение Lisp и что примечательно: примитивы, которые создаются этим Lisp-ом автоматически наследуют все свойста от свойств команды. Настройка команды - по правому щелчку мыши выбираете "Свойства" (properties).
Читайте справку по Tool Palettes , потому что это удивительно удобная и мощная вещь, с помощью которой я помещаю все объекты на свои слои. На каждый слой - по палитре.
Для блоков можно задать масштаб и его зависимость от переменной dimscale, что обеспечивает автоматическое масштабирование блоков в зависимости от масштаба вывода на печать.
Мне также нравится возможность помещать любое лисп-выражение, макрокоманду - это моментальное создание своей кнопки.
Любому инструменту на палитре можно задать свою картинку.

Profan · 12.09.2008, 19:47

Ну, это не для "клавишников".

Vova · 12.09.2008, 20:21

Цитата:

Сообщение от Красин

это удивительно удобная и мощная вещь, с помощью которой я помещаю все объекты на свои слои. На каждый слой - по палитре.

Например, меня сотня слоев. Значит, сотня палитр... Параллельно делается другой чертеж. В нем своя сотня, не всегда совпадающая с первой сотней. Ну, сутрировал немного, как и ты, верно?
.

Цитата:

Любому инструменту на палитре можно задать свою картинку.

Опиши технологию, пож. А еще лучше если создашь тему о палитрах и продублируешь свое сообщение туда, и мой вопрос тоже захвати

Красин · 12.09.2008, 20:52

Цитата:

Сообщение от Vova

Например, меня сотня слоев. Значит, сотня палитр... Параллельно делается другой чертеж. В нем своя сотня, не всегда совпадающая с первой сотней. Ну, сутрировал немного, как и ты, верно?

Абсолютно верно, за ислкючением того, что на палитре можно размещать flyoutы - кнопки с треугольничком, которые вмещают определенную панель инструментов. И при этом именно через палитры реализован интерфейс в Autodesk Building Systems 2006, MEP 2008. Там для каждого направления свой набор палитр: архитектурные, ОВэшные, ВК-шные. Создать свой набор палитр можно в настройках: правой клавишей по синей полоске, Custromize palettes, в правой половине диалога - наборы палитр. Переключаться между наборам тоже по правому клику ставишь галочку напротив своего.
С реакторами тоже не все просто будет, если число слоев перевалит за сотню, мне так кажется

Цитата:

Сообщение от Vova

Опиши технологию, пож. А еще лучше если создашь тему о палитрах и продублируешь свое сообщение туда, и мой вопрос тоже захвати

Если будет время, с большим удовольствием это сделаю, пусть я и не эксперт, вдруг кому пригодится.

Цитата:

Ну, это не для "клавишников".

Ну может быть, но мы все, даже самые закоренелые клавишники, указываем точки и примитивы на чертеже с помощью мыши, не так ли?

Кулик Алексей aka kpblc · 12.09.2008, 22:55

На палитрах штатными средствами AutoCAD можно разместить строго определенные Flyout'ы. Для создания собственных надо капитально ломать голову и, по-моему, использовать как минимум dll, подгружаемые через _.netload или ObjectARX. И, по-моему, в "чистом" autoCAD'e далеко не каждому инструменту можно назначить "любую" кнопку.
Ты, по-моему, немного не договариваешь о группировке палитр. Кстати, все эти вопросы уже поднимались на форуме (по-моему, в теме по играм с CUI).
---
По #96 : увы и ах, сейчас капитально не хватает времени на исправление. Может, кто из зубров подключится...

andrew_ro · 20.09.2008, 10:05

Да, видимо работы у всех действительно много. Будем ждать зимы.
Всем спасибо.

Vova · 20.09.2008, 16:30

Цитата:

Сообщение от Красин

Если будет время, с большим удовольствием это сделаю, пусть я и не эксперт, вдруг кому пригодится.

Я напоминаю о твоем обещании и надеюсь, что время найдется. Итак, как сделать в палитре вылетающие кнопки? Как сделать картинки? Я знаю про картинки только через CUI

Красин · 20.09.2008, 18:20

Цитата:

Сообщение от Vova

Я напоминаю о твоем обещании и надеюсь, что время найдется. Итак, как сделать в палитре вылетающие кнопки? Как сделать картинки? Я знаю про картинки только через CUI

Про создание картинок:
1) Если есть талант художника: рисуете квадрат в Автокаде, в этот квадрат вписываете свою картинку обычными примитивами автокада.
2) создаете из того, что вы вписали в квадрат, блок с характерным названием <название>, чтобы потом его найти.
3) сохраняете чертеж
4) перетаскиваете вхождение созданого вами блока на палитру. По успешному помещению этого блока на палитру автокад создает в папке ToolPallette\Pallettes\Images два рисунка в формате PNG с названиями <название>32.png и <название>64.png. Путь к ToolPallette можно посмотеть в Options на вкладке Files->Tool Pallettes File Location.
5)выделяте на tool pallette свой lisp, правым кликом вызываете контекстное меню, выбираете пункт Specify image.. - должен появиться стандартный диалог выбора файла с допустимыми расширениями gif,jpeg,bmp,png и открыться по умолчанию он должен именно в папке ToolPallette\Pallettes\Images. Указываете любую из созданных в п.4 картинок - и все: вместо стандартной картинки с листом бумаги со скобками и надписью LISP на нем появляется ваша иконка.

В принципе, картинку можно подготовить в любом графическом редакторе, но так как вы владеете авткадом, проще нарисовать в нем.
Блок нужен только для генерации картинки.

С вылетающими кнопками я погорячился, похоже, в автокаде все два предустановленных флайоута - с командами рисования и с размерами. Я даже не знаю пока, есть ли возможность создать дополнительные.
Я также думаю, что народ, который постился в теме "игры с CUI" знаем по-более моего, так что следите за новыми сообщениями там.

Чтобы создать свой лисп на палитре, перетащите туда любой примитив типа линии, текста из риснунка, зайдете в свойства созданного инструмента (properties в контекстном меню по правому клику ), выставьте use flyout в No, а Command string - ваш лисп или макрос. Можно перетащить на палитру команду из диалога настройки CUI

wetr · 09.10.2008, 04:22

VVA, а можно дополнить лисп №25 еще 2 элементами:
Перенос _table в слой "Таблицы"
Перенос _mleader в слой "_Выноски"?

VVA · 09.10.2008, 10:16

wetr, Обновил #25. С цветами слоев думаю сам разберешься

wetr · 09.10.2008, 10:57

VVA, отлично все работает!!!
Но есть 2 момента.
1) Реактор не срабатывает при вставке таблицы с помощью лиспа "vrc.lsp"
2) Реактор не срабатывает при вставке таблицы с помощью _dataextraction

VVA · 09.10.2008, 12:39

wetr, Реактор срабатывает на команду (например _table), а таблица в vrc вставляется с помощью vla-* методов. Реактор никоим способом ее не видит. Здесь нужно назначать слой таблицы в vrc.
Предлагаю использовать или ф-цибю Алексея _kpblc-layer-create из #47 или ее модификацию _dwgru-layer-create
Отличия

Цитата:

* Добавлен новый параметр suff - суффикс слоя, если он есть, то имя слоя получаестся путем
* добавления к имени существующего слоя суффикса suff

Подробнее вызов описан в примечаниях
Тогда код из #25 может выглядеть так
Важно Необходима ф-ция _dwgru-layer-create отсюда http://dwg.ru/f/showpost.php?p=93168&postcount=3

Код:

[Выделить все]

;;;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;;; Необходима ф-ция _dwgru-layer-create отсюда http://dwg.ru/f/showpost.php?p=93168&postcount=3
;;; Автор идеи Torino, он же Кочетков Андрей 
;;;Автоматический перенос размеров на слой "размеры" 
;;;и заливки на слой "заливка" 
;;;Просто добавь этот файл в автозагрузку

(vl-load-com)
(_dwgru-layer-create '(("name" . "Размеры")("color" . 1)))
(_dwgru-layer-create '(("name" . "Штриховка")("color" . 5)))
(_dwgru-layer-create '(("name" . "Текст")("color" . 6)))
(_dwgru-layer-create '(("name" . "Таблицы")("color" . 2)))
(_dwgru-layer-create '(("name" . "Выноски")("color" . 3)))
(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" "Текст") 
    )
    ((wcmatch thecommandstart "*TABLE") ;_Если выполняется команда *TEXT (TEXT DTEXT) 
     (setvar "clayer" "Таблицы") 
    )
    ((wcmatch thecommandstart "*LEADER") ;_Если выполняется команда *QLEADER MLEADER
     (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)
      (wcmatch cmd_name "*TABLE")   ;_Если выполняется команда ТАБЛИЦА
      (wcmatch cmd_name "*LEADER")   ;_Если выполняется команда *QLEADER или MLEADER
      )
  (progn
    (if *OldLayer* (setvar "clayer" *OldLayer*)) 
    (setq *OldLayer* nil)
    ))
 (princ))

А в vrc нужно добавить что-то типа такого :

Код:

[Выделить все]

;;; В переменной table vla-указатель на добавленную таблицу
(vla-put-layer table (vla-get-name(_dwgru-layer-create '(("name" . "Таблицы")))))

wetr · 09.10.2008, 13:48

Дело в том, что функция Алексея не работает в 2009 каде. Ну или я ее не смог запустить. Поместил в автогагрузку, а при создании нового файла пишет

Код:

[Выделить все]

AutoCAD menu utilities loaded.; error: no function definition: 
VLAX-GET-ACAD-OBJECT

Проверил в 2006 - код Алексея работает
Твой код работает на ура. Я потому к тебе и обратился.

VVA · 09.10.2008, 13:52

wetr, Добавь в начало (vl-load-com) (лучше самой первой строкой автозагрузки (mnl или lsp файла)

wetr · 09.10.2008, 14:13

Цитата:

wetr, Добавь в начало (vl-load-com) (лучше самой первой строкой автозагрузки (mnl или lsp файла)

ага, заработало.
И в эту функцию _dwgru-layer-create, тоже добавить пришлось.

Цитата:

Предлагаю использовать или ф-цию Алексея

Владимир, как скажешь!

А в чем отличия? Я заметил только, что реактор крыса создает слои только после выполнения команды, а твой сразу при загрузке нового файла

VVA · 09.10.2008, 14:20

Про реакторы не скажу, не смотрел.
_dwgru-layer-create отличается от ф-ции Алексея только

Цитата:

* Добавлен новый параметр suff - суффикс слоя, если он есть, то имя слоя получаестся путем
* добавления к имени существующего слоя суффикса suff

Выполни

Код:

[Выделить все]

(_dwgru-layer-create '(("suff" . "_Проба")))

Запомни имя текущего слоя и посмотри на созданные слои

wetr · 09.10.2008, 16:38

Спасибо, VVA. Теперь я знаю для кого пишут коменты в лиспах

Вот здесь попробовал - все получилось. Добавил еще непечатаемый слой "_Вспомогательные" реагирует на простановку _xline. И добавил обработку команды _dataextraction. Все работает вроде. Тьфу-тьфу, штоб не сглазить

В общем с меня пыво

Код:

[Выделить все]

(vl-load-com)
;;;================== Сервисные ф-ции BEGIN

;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
;|=============================================================================
*   На основе ф-ции _kpblc-layer-create
*   http://dwg.ru/forum/viewtopic.php?t=3116&start=45&sid=fab803bd4dbda125ffdc6c07563f682a
*   пост № 47
*   Добавлен новый  параметр  suff - суффикс слоя, если он есть, то имя слоя получаестся путем
*   добавления к имени существующего слоя суффикса suff
*   Создание слоя с указанными параметрами.
*   Параметры вызова:
*   layer-list   список параметров слоя вида:
   '(("name" . "TestLayer")   ; имя слоя. может быть пропущено, если указан suff
     ("color" . 3)         ; номер цвета. nil -> 7
     ("lw" . 50)         ; вес линии слоя. nil -> 25
*                          Оно выражается в сотых долях миллиметра и может быть любым
*                          из следующего ряда: 0, 5, 9, 13, 15, 18, 20, 25, 30, 35, 40, 50, 53, 60, 70,
*                          80, 90, 100, 106, 120, 140, 158, 200 и 211.
     ("lt" . "hidden")      ; тип линии слоя. nil -> Continuous
               ; Если описания типа линии в acadiso.lin
               ; нет, обязательно указывать следующий
               ; параметр
   ("ltfile" . "c:\\cad\\ltypes\\lt.lin")   ; полный путь к файлу с описанием
               ; типа линии. Если файл находится в путях
               ; поддержки, путь можно не указывать
   ("plot" . "y")         ; Печатать ("y") или нет ("n") слой.
               ; nil -> "y"
   ("suff" . "_Размеры")  ;_Добавляемый суффикс с текущему слою. Если задан, поле "name" игнорируется            
   )
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*    Слой размораживается, разблокируется и включается. Не активируется.
* Примеры:
  (_dwgru-layer-create '(("name" . "Test")("color" . 1)("lw" . 50)))
* создать если нет и слой Test цветом 1 (красный) весом линии 0.5

=========================================================================|;

(defun _dwgru-layer-create (layer-list / vla_layer buf)
       (setq *MIP-CLAYER-PROP-SETTING*
     (list (cons "layer"
   (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of cons
    (cons "color" (getvar "cecolor"))
    (cons "lw" (getvar "celweight"))
    (cons "lt" (getvar "celtype"))
    ) ;_ end of list
    ) ;_ end of setq

  ;;;Если есть suff добавляем в начало списка,
  ;;;чтобы assoc нашел раньше
  (if (cdr(assoc "suff" layer-list))
    (progn
     (setq layer-list (vl-remove (assoc "name" layer-list) layer-list))
     (setq layer-list (append (list(cons "name" (strcat (getvar "clayer") (cdr(assoc "suff" layer-list))))) layer-list))
    )
  )
  (setq vla_layer
  (vla-add
    (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (if (snvalid (cdr (assoc "name" layer-list)))
        (cdr (assoc "name" layer-list))
        "0"
      )
    ) ;_ end of vla-add
 ) ;_ end of setq
  (vla-put-color
    vla_layer
    (if (setq buf (cdr (assoc "color" layer-list)))
      buf
      7
      ) ;_ end of if
    ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if (setq buf (cdr (assoc "lw" layer-list)))
      (if (member buf (list acLnWt000  acLnWt030  acLnWt090
    acLnWt005  acLnWt035  acLnWt100
    acLnWt009  acLnWt040  acLnWt106
    acLnWt013  acLnWt050  acLnWt120
    acLnWt015  acLnWt053  acLnWt140
    acLnWt018  acLnWt060  acLnWt158
    acLnWt020  acLnWt070  acLnWt200
    acLnWt025  acLnWt080  acLnWt211
    )
    )
    buf
    acLnWtByLwDefault
 )
      acLnWtByLwDefault
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (setq buf (cdr (assoc "lt" layer-list)))
    (_kpblc-linetype-load
      buf
      (cdr (assoc "ltfile" layer-list))
      ) ;_ end of _kpblc-linetype-load
    ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if (= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer (vla-get-activedocument (vlax-get-acad-object)))
    vla_layer
    ) ;_ end of equal
    ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun

;;;================== Сервисные ф-ции END

;;; Реактор

(or *kpblc-activedoc*
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))))

(setq VLR-react (VLR-SysVar-Reactor nil (list '(:VLR-sysVarChanged . chrzmstyle)))) 
(defun chrzmstyle (name event / nstyle)
  (if (= (car event) "DIMSTYLE")
    (progn
      (setq nstyle (getvar "DIMSTYLE")
	    nstyle (str-str-lst nstyle "_")
	    nstyle (VL-STRING-RIGHT-TRIM "_" (apply 'strcat (mapcar '(lambda (x) (strcat x "_"))(cdr nstyle)))))
      (if (snvalid nstyle)
	(progn
	  (setq nstyle (strcat "Размерные_" nstyle))
	  (vla-put-activelayer *kpblc-activedoc*
          (_dwgru-layer-create (list (cons "name" nstyle))))
	  )
	)
      )
    )
  (princ) 
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Автор идеи Torino, он же Кочетков Андрей 
;;;Автоматическая простановка размеров в слое "_Размеры", 
;;;штриховки в слое "_Штриховки", текстов в слое "_Тексты", 
;;;таблиц в слое "_Таблицы", лидеров в слое "_Выноски", прямых
;;;в слое "_Вспомогательный". Реактор работает только с указанными
;;;командами. 
;;;Просто добавь этот файл в автозагрузку

(vl-load-com)
(_dwgru-layer-create '(("name" . "_Размеры")("color" . 150)("lw" . 13)))
(_dwgru-layer-create '(("name" . "_Штриховки")("color" . 5)("lw" . 9)))
(_dwgru-layer-create '(("name" . "_Тексты")("color" . 6)("lw" . 15)))
(_dwgru-layer-create '(("name" . "_Таблицы")("color" . 2)("lw" . 20)))
(_dwgru-layer-create '(("name" . "_Выноски")("color" . 3)("lw" . 15)))
(_dwgru-layer-create '(("name" . "_Вспомогательные")("color" . 1)("lw" . 15)("plot" . "n")))
(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 DTEXT 
     (setvar "clayer" "_Тексты") 
    )
    ((wcmatch thecommandstart "*TABLE") ;_Если выполняется команда TABLE 
     (setvar "clayer" "_Таблицы") 
    )
    ((wcmatch thecommandstart "*LEADER") ;_Если выполняется команда QLEADER MLEADER
     (setvar "clayer" "_Выноски")
    )
    ((wcmatch thecommandstart "*XLINE") ;_Если выполняется команда XLINE
     (setvar "clayer" "_Вспомогательные")
    )
    ((wcmatch thecommandstart "*DATAEXTRACTION") ;_Если выполняется команда dataextraction
     (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)
      (wcmatch cmd_name "*TABLE")   ;_Если выполняется команда ТАБЛИЦА
      (wcmatch cmd_name "*LEADER")   ;_Если выполняется команда *QLEADER или MLEADER
      (wcmatch cmd_name "*XLINE")   ;_Если выполняется команда *XLINE
      (wcmatch cmd_name "*DATAEXTRACTION")   ;_Если выполняется команда *DATAEXTRACTION
      )
  (progn
    (if *OldLayer* (setvar "clayer" *OldLayer*)) 
    (setq *OldLayer* nil)
    ))
 (princ))

gipro · 11.10.2008, 11:39

VVA, у меня возникает следующая проблема... Код из поста 25 работает, но после завершения команды часто возвращается не на предыдущий слой, а на сохраненный по умолчанию текущим в шаблоне чертежа. Иногда вообще не возвращается. У меня стоит AutoCAD 2008 русский + СПДС. Может это в ней дело?
Прикладываю ролики...

VVA · 11.10.2008, 18:35

gipro, Вполне возможно. У меня нет опыта эксплуатации #25. Скорее это нужно спросить у wetr (про возвращение слоя). Там все простою: при старте команды слой запоминается в переменной и устанавливается текущим, по окончании восстанавливается сохраненный.

andrew_ro · Регистрация: 29.07.2008

VVA, wetr: ну просто супер!

Однако есть одно несущественное неудобство. Допустим нужно открыть файл только чтобы просмотреть его содержимое не производя никаких действий. В этом случае при закрытии файла AutoCAD выдает запрос о сохранении изменений. А если таких файлов нужно открыть и закрыть несколько подряд (мне иногда приходится просматривать каталоги алюминиевых профилей в dwg-формате) - появляется много рутины.
В связм с этим вопрос: нельзя ли создание слоя повесить не на открытие чертежа, а на ту или иную команду, как это сделано у kpblca в #47.
Буду очень благодарен

VVA · 11.10.2008, 23:25

andrew_ro, Вариант из #25 (вариант с функциями _dwgru-layer-create в коментариях, сама ф-ция по ссылке #108 или в #113)
Две команды:
CRON - Command Reactor ON Включает командный реактор
CROFF - Command Reactor OFF Отключает командный реактор.
Можно в процессе работы приостанавливать разнос примитивов по слоям и снова включать

Код:

[Выделить все]

;;; Автор идеи Torino, он же Кочетков Андрей 
;;;Автоматический перенос размеров на слой "размеры" 
;;;и заливки на слой "заливка" 

(vl-load-com)
;;;Команда включает реактор
;;; CrOn - Command Reactor On
(defun C:CrOn ()
(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
;;;;;;По аналогии добавить создание своего слоя 
;;; ...
;;; Вариант с функцией _dwgru-layer-create
;;; отсюда   http://forum.dwg.ru/showpost.php?p=294776&postcount=108
;;;===============================================================
;;;
;;;(_dwgru-layer-create '(("name" . "Размеры")("color" . 1)))
;;;(_dwgru-layer-create '(("name" . "Штриховка")("color" . 5)))
;;;(_dwgru-layer-create '(("name" . "Текст")("color" . 6)))
;;;(_dwgru-layer-create '(("name" . "Таблицы")("color" . 2)))
;;;(_dwgru-layer-create '(("name" . "Выноски")("color" . 3)))
;;;
;;;==============================================================
  
(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)))))
)
;;;Выключает командный реактор
;;;CrOff - Command reactor off
(defun C:CrOff ()
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
  )
;;;;;;------------------------------------------------------------- 
(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") ;_Если выполняется команда *TEXT (TEXT DTEXT) 
     (setvar "clayer" "Таблицы") 
    )
    ((wcmatch thecommandstart "*LEADER") ;_Если выполняется команда *QLEADER MLEADER
     (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)
      (wcmatch cmd_name "*TABLE")   ;_Если выполняется команда ТАБЛИЦА
      (wcmatch cmd_name "*LEADER")   ;_Если выполняется команда *QLEADER или MLEADER
      )
  (progn
    (if *OldLayer* (setvar "clayer" *OldLayer*)) 
    (setq *OldLayer* nil)
    ))
 (princ))

andrew_ro · 11.10.2008, 23:59

VVA, спасибо. Возможность откл/вкл реактор добавляет универсальность программе.
И еще я не пойму как задать суффикс имени слоя. Если я правильно понял, при открытии чертежа, в котором есть слой "Размеры", имя слоя изменится на "_Размеры" без создания нового слоя? Какую строку и в какое место в коде нужно добавить? Перепробовал несколько вариантов с учетом #112, но в результате: например, если говорить о нулевом слое, появляется слой с именем "0_Размеры". Что я делаю не так?

andrew_ro · 12.10.2008, 11:21

VVA,

Цитата:

CRON - Command Reactor ON Включает командный ректор
CROFF - Command Reactor OFF Отключает командный ректор

работает именно так:

Цитата:

...процессе работы приостанавливать разнос примитивов по слоям и снова включать

.
А хотелось бы из открытого чертежа отключать создание слоев во вновь открываемых файлах.
P.S. Я извиняюсь за навязчивось, уж больно полезная программа и хочется отшлифовать ее.

MichaelBY · 12.10.2008, 13:53

Всема большое спасибо за сие создание

dextron3 · 12.10.2008, 15:38

VVA, а спдсные объекты можно разносить?

DEM · 12.10.2008, 15:40

Цитата:

Сообщение от dextron3

VVA, а спдсные объекты можно разносить?

Так там же автоматом можно и так.

VVA · 12.10.2008, 16:08

andrew_ro,

Цитата:

появляется слой с именем "0_Размеры". Что я делаю не так?

Цитата:

* Добавлен новый параметр suff - суффикс слоя, если он есть, то имя слоя получаестся путем
* добавления к имени текущего слоя суффикса suff

Работает так как и было задумано. То, что хочешь ты называется переименование (команда _rename)

Цитата:

А хотелось бы из открытого чертежа отключать создание слоев во вновь открываемых файлах.

Код из #117 так и делает, пока не наберешь CRON никаких реакторов не загрузится. Может у тебя по прежнему болтается код из #25 в автозагрузке?
dextron3, Здесь реакторы на команды. Поэтому теоретически можно, но сам СПДС может менять слой своих объетов после создания vla или arx методами. Тем более, что у СПДС есть родные инструменты.

andrew_ro · 12.10.2008, 16:50

VVA, все получилось. Код из #25 действительно висел в атозагрузке: я думал что код из #117 дополнение, а не самостоятельная программа.
Спасибо ну просто ОГРОМНОЕ! Это даже больше, чем я хотел здесь.

wetr · 12.10.2008, 16:53

andrew_ro, насколько я понял тебе и нужен код Алексея.
попробуй
*добавлено по сравнению с №47
- слой "_Таблицы" для таблиц (включая _dataextraction)
- слой "_Выноски" для лидеров
- слой "_Вспомог" для прямой

*Добавлено*
"И тут Остапа понесло..."

- слой "VPORTS" для вьюпортов

Слои и толщины настраивай под себя

Код:

[Выделить все]

(vl-load-com)
(if (not *kpblc-activedoc*)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of if

(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-cancel)
		      (:vlr-commandfailed . cmd-fail)
		      )
		    ) ;_ end of VLR-Command-Reactor
	) ;_ end of setq
  ) ;_ end of if
;; Функция подгрузки типа линии - на http://www.autocad.ru/cgi-bin/f1/board.cgi?t=22730iW

;|=============================================================================
*    Создание слоя с указанными параметрами.
*    Параметры вызова:
*   layer-list   список параметров слоя вида:
   '(("name" . "TestLayer")   ; имя слоя. Не может быть пропущено
   ("color" . 3)         ; номер цвета. nil -> 7
   ("lw" . 50)         ; вес линии слоя. nil -> 25
   ("lt" . "hidden")      ; тип линии слоя. nil -> Continuous
               ; Если описания типа линии в acadiso.lin
               ; нет, обязательно указывать следующий
               ; параметр
   ("ltfile" . "c:\\cad\\ltypes\\lt.lin")   ; полный путь к файлу с описанием
               ; типа линии. Если файл находится в путях
               ; поддержки, путь можно не указывать
   ("plot" . "y")         ; Печатать ("y") или нет ("n") слой.
               ; nil -> "y"
   )
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*    Слой размораживается, разблокируется и включается. Не активируется.
|;
(defun _kpblc-layer-create (layer-list / vla_layer)
  (setq	vla_layer
	 (vla-add
	   (vla-get-layers *kpblc-activedoc*)
	   (cdr (assoc "name" layer-list))
	   ) ;_ end of vla-add
	) ;_ end of setq
  (vla-put-color
    vla_layer
    (if	(cdr (assoc "color" layer-list))
      (cdr (assoc "color" layer-list))
      7
      ) ;_ end of if
    ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if	(cdr (assoc "lw" layer-list))
      (cdr (assoc "lw" layer-list))
      aclnwt025
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (cdr (assoc "lt" layer-list))
	   (_kpblc-linetype-load
	     (cdr (assoc "lt" layer-list))
	     (cdr (assoc "ltfile" layer-list))
	     ) ;_ end of _kpblc-linetype-load
	   ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if	(= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer *kpblc-activedoc*)
		  vla_layer
		  ) ;_ end of equal
	   ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun

(defun cmd-start (react	   cmd	    /	     selset   cmd_name ent
		  svr	   res	    tag	     text     index    _attreq_
		  _attdia_
		  )
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((vl-string-search "dim" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "_Размеры")
	   ("color" . 165)
	   ("lw" . 13)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ((vl-string-search "hatch" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "_Штриховки")
	   ("color" . 175)
	   ("lw" . 09)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ((vl-string-search "text" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "_Тексты")
	   ("color" . 190)
	   ("lw" . 15)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ((vl-string-search "table" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "_Таблицы")
	   ("color" . 7)
	   ("lw" . 09)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ((vl-string-search "leader" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "_Выноски")
	   ("color" . 150)
	   ("lw" . 13)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ((vl-string-search "dataextraction" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "_Таблицы")
	   ("color" . 7)
	   ("lw" . 09)
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
     ((vl-string-search "xline" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "_Вспомог")
	   ("color" . 1)
	   ("lw" . 09)
	   ("plot" . "n")
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ((vl-string-search "vports" cmd_name)
     (setq *vlr-settings*
	    (list (cons	"layer"
			(vla-get-activelayer *kpblc-activedoc*)
			) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer
       *kpblc-activedoc*
       (_kpblc-layer-create
	 '(("name" . "VPORTS")
	   ("color" . 81)
	   ("lw" . 13)
	   ("plot" . "n")
	   )
	 ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar
	     '("cecolor" "celweight" "celtype")
	     '("bylayer" -1 "bylayer")
	     ) ;_ end of mapcar
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-end (react	     cmd	  /	       list_obj
		selset	     item	  counter      leader_item
		cmd_name     leader_item_list	       up_string
		low_string
		)
  (setq	cmd_name (strcase (car cmd) t)
	counter	 0
	) ;_ end of setq
  (cond
    ((or (vl-string-search "dim" cmd_name)
	 (vl-string-search "text" cmd_name)
	 (vl-string-search "hatch" cmd_name)
	 (vl-string-search "dataextraction" cmd_name)
	 (vl-string-search "leader" cmd_name)
	 (vl-string-search "table" cmd_name)
	 (vl-string-search "xline" cmd_name)
         (vl-string-search "vports" cmd_name)
	 ) ;_ end of or
     (if *vlr-settings*
       (progn
	 (vla-put-activelayer
	   *kpblc-activedoc*
	   (cdr (assoc "layer" *vlr-settings*))
	   ) ;_ end of vla-put-ActiveLayer
	 (mapcar 'setvar
		 '("cecolor" "celweight" "celtype")
		 (list (cdr (assoc "color" *vlr-settings*))
		       (cdr (assoc "lw" *vlr-settings*))
		       (cdr (assoc "lt" *vlr-settings*))
		       ) ;_ end of list
		 ) ;_ end of mapcar
	 (setq *vlr-settings* nil)
	 ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-cancel (react cmd / cmd_name)
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((or (vl-string-search "dim" cmd_name)
	 (vl-string-search "text" cmd_name)
	 (vl-string-search "hatch" cmd_name)
         (vl-string-search "dataextraction" cmd_name)
	 (vl-string-search "leader" cmd_name)
	 (vl-string-search "table" cmd_name)
	 (vl-string-search "xline" cmd_name)
         (vl-string-search "vports" cmd_name)
	 ) ;_ end of or
     (if *vlr-settings*
       (progn
	 (vla-put-activelayer
	   *kpblc-activedoc*
	   (cdr (assoc "layer" *vlr-settings*))
	   ) ;_ end of vla-put-ActiveLayer
	 (mapcar 'setvar
		 '("cecolor" "celweight" "celtype")
		 (list (cdr (assoc "color" *vlr-settings*))
		       (cdr (assoc "lw" *vlr-settings*))
		       (cdr (assoc "lt" *vlr-settings*))
		       ) ;_ end of list
		 ) ;_ end of mapcar
	 (setq *vlr-settings* nil)
	 ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

;|=============================================================================
*    Функция подгрузки типа линии в текущий файл. Учитывает возможную
* локализацию системы.
*    Параметры вызова:
*  ltype-name  имя типа линии для английской версии
*  ltype-file  имя файла описания типа линии. nil -> "acadiso.lin"ю
*      Если файл с описанием типа линии не лежит по путям
*      поддержки када, надо указывать полный путь к нему.
*    Примеры вызова:
(_kpblc-linetype-load "center" nil)  ; для русской версии подгружает Осевая и возвращает
                                     ; t при успехе
***  Соответствие наименований линий обеспечивается огромным списком ltype_list
*** который можно и нужно дополнять :) Только надо либо все делать мелкими
*** буквами, либо жестко соблюдать регистр в моменты вызовов.
***  Тип линии "Continuous" обработке не подвергается — он есть во всех версиях
=============================================================================|;
(defun _kpblc-linetype-load
       (ltype-name ltype-file / ltype_normal ltype_list result)
  (vl-load-com)
  (setq	ltype_list '(("center" . "осевая")
		     ("center2" . "осевая2")
		     ("hidden" . "скрытая")
		     ("hidden2" . "скрытая2")
		     )
	ltype-name (strcase ltype-name t)
	) ;_ end of setq
  (if (not ltype-file)
    (setq ltype-file "acadiso.lin")
    ) ;_ end of if
  (if (vl-string-search "419" (vlax-product-key))
    ;; Русская версия, меняем имя типа линии
    (setq ltype_normal (cdr (assoc ltype-name ltype_list)))
    (setq ltype_normal ltype-name)
    ) ;_ end of if
  (if (not (tblsearch "ltype" ltype_normal))
    ;; тип линии не найден, надо его загрузить. Тип линии должен быть
    ;; описан в файле
    (setq result (not (vl-catch-all-error-p
			(vl-catch-all-apply
			  'vla-load
			  (list
			    (vlax-get-property
			      (vla-get-activedocument (vlax-get-acad-object))
			      'linetypes
			      ) ;_ end of vlax-get-property
			    ltype_normal
			    ltype-file
			    ) ;_ end of list
			  ) ;_ end of vl-catch-all-apply
			) ;_ end of vl-catch-all-error-p
		      ) ;_ end of not
	  ) ;_ end of setq
    ) ;_ end of if
  result
  ) ;_ end of defun

Отличие этого кода от кода в №113 (для простого юзера)
В №113 слои создаются сразу при открытии файла - даже нового (авторы Кочетков Андрей, VVA, krblc)
В этом коде слои создаются только при вызове соответствующей команды (автор krblc)

gest · 17.10.2008, 14:11

Не подскажете, возможно автоматически относить штриховки созданные с помощью палитр, к слою штриховка?

wetr · 17.10.2008, 14:50

настройка через ПК мыши

gest · 17.10.2008, 15:00

Это понятно нужно прописывать, хотелось бы по теме обсуждения автоматический перенос.

VVA · 17.10.2008, 16:08

При вставке из палитр выполняется команда EXECUTETOOL. Как на команду реактор поставить можно (скорее всего), но понять что в данный момент вставляется (штриховка или блок) не возможно. Так что на слой штриховки будут попадать и блоки. Правильнее как в #127.

andrew_ro · 17.10.2008, 16:16

wetr, спасибо.
Я давно не заглядывал в ветку, потому что сам методом проб и ошибок (ну их практически не было) переделал код Алексея из #47 "под себя". Сейчас тестирую.Только почемуто он не работает в версиях AutoCAD выше 2007. Заодно поэкспериментирую и с твоим из #125.
Еще раз спасибо.

wetr · 17.10.2008, 16:25

Цитата:

Сообщение от andrew_ro

Только почемуто он не работает в версиях AutoCAD выше 2007.

м.б. надо подгрузить visual lisp ? (vl-load-com)

andrew_ro · 17.10.2008, 16:35

Цитата:

м.б. надо подгрузить visual lisp ? (vl-load-com)

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

wetr · 17.10.2008, 17:52

andrew_ro, я делаю точно также

Кулик Алексей aka kpblc · 17.10.2008, 23:22

Цитата:

Сообщение от andrew_ro

wetr, спасибо.
Я давно не заглядывал в ветку, потому что сам методом проб и ошибок (ну их практически не было) переделал код Алексея из #47 "под себя". Сейчас тестирую.Только почемуто он не работает в версиях AutoCAD выше 2007. Заодно поэкспериментирую и с твоим из #125.
Еще раз спасибо.

У меня код с реакторами (ну, конечно, со своими добавлениями) успешно работает в ADT2008Eng.

andrew_ro · 18.10.2008, 12:17

Действительно нужно было

Цитата:

подгрузить visual lisp (vl-load-com)

. Протестировал в Civil 3D 2008 (rus) и в AutoCAD 2009 (eng). Все работает.

Tony_Chu · 25.11.2008, 12:30

Код:

[Выделить все]

("name" . "size")
("color" . 1)
("lw" . 20)

Подскажите пож-ста как задать толщину линии не 0,20, а по умолчанию, а то я в лиспе ни черта не соображаю.

VVA · 25.11.2008, 12:40

Код:

[Выделить все]

acLnWtByLayer = -1
acLnWtByBlock = -2
acLnWtByLwDefault = -3

Т.е так должно работать

Код:

[Выделить все]

("lw" . -3)

Tony_Chu · 25.11.2008, 14:16

to VVA

Спасибо большое, всё работает

beholder · Регистрация: 27.11.2007

Скачал здесь на форуме код, который загоняет размеры и текст на нужные слои, переделал его под себя, вроде бы все было чудесно на 2007-м акаде, но когда попробовал загрузить у сотрудника на 2009-м возникла следующая ситуация. Допустим, у меня активен другой слои, не размеры. Я проставляю размер (он проставляется в нужном мне слое РАЗМЕРЫ), дальше активным вновь становится мой текущий слой, но (!) после этого я уже не могу сделать активным любой другой слой кроме того, который был до проставления размера, назначить любой слой объекту могу, а сделать слой текущим нет. Такой глюк появился только в 2009-й версии акада.

Прилагаю этот самый код:

Код:

[Выделить все]

(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))) '("РАЗМЕРНАЯ" "ТЕКСТ")));

(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" "РАЗМЕРНАЯ"))
	((wcmatch thecommandstart "*TEXT") (setvar "clayer" "ТЕКСТ"))
	(t nil));cond 
  (princ)
);startCommand
;
(defun endCommand (calling-reactor endcommandInfo) 
 (if *OldLayer* (setvar "clayer" (nth 0 *OldLayer*))) 
 (setq *OldLayer* nil) 
 (princ) 
);endCommand

Прошу знатоков лиспа подсказать мне в чем может быть дело. Я сам на данный момент только начал изучать лисп по скачанных тут уроках (автолисп в восьми уроках), со временем, может буду что-то посерьезнее читать, а пока только знакомлюсь с основными понятиями.

Кулик Алексей aka kpblc · 25.11.2008, 23:33

Скорее всего, реакторы загружаются несколько раз и поэтому "хамят". Попробуй такой код:

Код:

[Выделить все]

(vl-load-com)

(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
           "-command-reactor"
           '(
             (:vlr-commandwillstart . startcommand)
             (:vlr-commandended . endcommand)
             (:vlr-commandcancelled . endcommand)
             (:vlr-commandfailed . endcommand)
             )
           ) ;_ end of VLR-Command-Reactor
        ) ;_ end of setq
  ) ;_ end of if

(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)
                        ) ;_ end of if
                      ) ;_ end of lambda
                   '("РАЗМЕРНАЯ" "ТЕКСТ")
                   ) ;_ end of mapcar
      ) ;_ end of setq

(defun startcommand (calling-reactor startcommandinfo / thecommandstart)
  (setq thecommandstart (car startcommandinfo))
  (setq *oldlayer* (getvar "CLAYER"))
  (cond ((wcmatch thecommandstart "DIM*") (setvar "clayer" "РАЗМЕРНАЯ"))
        ((wcmatch thecommandstart "*TEXT") (setvar "clayer" "ТЕКСТ"))
        ) ;_ end of cond
  ) ;_ end of defun

(defun endcommand (calling-reactor endcommandinfo)
  (if *oldlayer*
    (setvar "clayer" *oldlayer*)
    ) ;_ end of if
  (setq *oldlayer* nil)
  ) ;_ end of defun

beholder · 25.11.2008, 23:59

Кулик Алексей aka kpblc, большое спасибо, завтра на работе попробую.

beholder · 27.11.2008, 23:42

Кулик Алексей aka kpblc, попробовал твой код, - результат точто такой же, как и с моим, причем пробовал на разных машинах, так же как и было - после загрузки невозможно установить текущим ни одного другого слоя, назначить же слой объекту удается... Если может кому-нибудь другому у кого стоит 2009-й акад попробовать как работает данный код у него на машине, буду очень благодарен.p.s. Код в посте №140, нужен обязательно 2009-й акад (на других, по крайней мере на 2007-м и 2006-м проблем не возникает).

VVA · 28.11.2008, 10:51

beholder, То что показал Алексей не лишне. Вскрытие показало наличие грубейшей ошибки в логике. Непоянтно почему это работало в предыдущих версиях ??? К коду №140 Добавил исправление ошибки (выделил красным) и добавил 2 команды (CMDS и CMDE) на аткивации и остановки командных реакторов в сеансе работы

Код:

[Выделить все]

(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))) '("РАЗМЕРНАЯ" "ТЕКСТ")));
(defun cmdr-remove ()
(if *vlr-cmd*
  (progn
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
    ) ;_ end of progn
  ) ;_ end of if
  )
(defun cmdr-create ()
(if (not *vlr-cmd*)
  (setq *vlr-cmd*
         (vlr-command-reactor
           "-command-reactor"
           '(
             (:vlr-commandwillstart . startcommand)
             (:vlr-commandended . endcommand)
             (:vlr-commandcancelled . endcommand)
             (:vlr-commandfailed . endcommand)
             )
           ) ;_ end of VLR-Command-Reactor
        ) ;_ end of setq
  ) ;_ end of if
  )
(defun startCommand (calling-reactor startcommandInfo / thecommandstart)
  (setq thecommandstart (nth 0 startcommandInfo))
  (setq *OldLayer* (append *OldLayer* (list (getvar "CLAYER"))))
      (cond ((wcmatch thecommandstart "DIM*") (setvar "clayer" "РАЗМЕРНАЯ"))
            ((wcmatch thecommandstart "*TEXT") (setvar "clayer" "ТЕКСТ"))
            (t (setq *OldLayer* nil)) ;;_Если не наша команда, чистим список текущих слоев
            );cond
      (princ)
);startCommand
(defun endCommand (calling-reactor endcommandInfo) 
 (if *OldLayer* (setvar "clayer" (nth 0 *OldLayer*))) 
 (setq *OldLayer* nil)
;;; (cmdr-remove)
;;;(cmdr-create)
 
 (princ) 
);endCommand
;;;Активировать командный реактор
;;;CoMmanD reactor Start
(defun C:CMDS ()
(cmdr-remove)
(cmdr-create)
  )
;;;Удалить командный реактор
;;;CoMmanD reactor End
(defun C:CMDE ()(cmdr-remove))
(cmdr-remove)
(cmdr-create)

beholder · 29.11.2008, 23:47

Спасибо, VVA, теперь код чудесно работает на любой версии ))) Буду теперь постепенно распространять среди сотрудников.

VVA · 30.11.2008, 12:31

Отредактировал код в #25

dextron3 · 30.11.2008, 16:53

VVA, Хотел спросить можно ли с помощью лиспа менять у текста Justify ? (центральный, левый и правый, путем выделения прямоугольником автокада)

VVA · 30.11.2008, 18:08

dextron3, А _justifytext чем не устраивает?

dextron3 · 30.11.2008, 18:49

VVA, спасибо, а что вы делаете когда у вас кнопки на экране уже в три ряда и все нужные, места где рисовать не осталось
посоветуйте, пробовал включающие кнопки для панелей назначить так позиционирование на экране не удобно...

VVA · 30.11.2008, 21:05

Цитата:

что вы делаете когда у вас кнопки на экране уже в три ряда и все нужные

У меня нет 3 рядов кнопок. Некоторые команды набираю в ком. строке или знаю где они находятся в меню.
Наиболее частые - алиасы и tool palette
Например, команда _justifytext находится в меню Редактировать->Объект->Текст->Выравнивание

dextron3 · 01.12.2008, 09:26

VVA, а выпадающими кнопками пользуетесь? или они 2 секунды тратять времени пока выпадают поэтому не прижились...

VVA · 01.12.2008, 10:33

пользуюсь

Mäher · 07.12.2008, 22:41

Всем привет! Подскажите пожайлуста, возможно ли автоматически присваивать разрмеру слой "разрмеры", если вызывать команду с клавы?

Кулик Алексей aka kpblc · 07.12.2008, 22:52

Можно. Вся эта тема как раз решению этого вопроса и посвящена.

Mäher · 07.12.2008, 23:01

А можно узнать по подробнее, т.к. в лиспе не силен. Я пробовал макросы опубликованные в разделе "Статьи", но они работают, только если размер проставлять с помощью соответствующей кнопки в панели.

Кулик Алексей aka kpblc · 07.12.2008, 23:11

Попробуй код с http://forum.dwg.ru/showpost.php?p=60065&postcount=47

Mäher · 07.12.2008, 23:29

А куда этот код нужно внести?

Извеняюсь, что на ночь глядя напрягаю.

Кулик Алексей aka kpblc · 07.12.2008, 23:33

http://dwg.ru/art/8

Mäher · 07.12.2008, 23:39

Все понял, спасибо огромное за помощь.

Vova · 08.12.2008, 16:41

Цитата:

Сообщение от Mäher

Всем привет! Подскажите пожайлуста, возможно ли автоматически присваивать разрмеру слой "разрмеры", если вызывать команду с клавы?

Можно если использовать Temporary Override key, но я забыл, как

dREYb · 11.12.2008, 22:09

А есть код для русского 2006 када? У меня не начал работать только в английской версии

Кулик Алексей aka kpblc · 11.12.2008, 22:22

dREYb, какой код не работает-то?

dREYb · 11.12.2008, 22:49

Кулик Алексей aka kpblc Я брал из этой ветки! потом запустил у друга в 2006 рус не покатило! я так понял! команды не прокатывают! может тыкните носом где взять последний стабильный код для 2006! Оч благодарен!

Кулик Алексей aka kpblc · 11.12.2008, 23:17

Все коды подряд я не отслеживал. Мой код (который в #47, кажется), у меня корректно работал везде где только можно (AutoCAD'ы начиная с версии 2002 по 2008, разные локализации и разные вертикальные решения). Ткни пальцем в пост, про который ты говоришь!

VVA · 12.12.2008, 11:05

dREYb, Точно рабочие см. посты #47 и #25

dREYb · 15.12.2008, 22:52

#25 попробовал! прокатил! У меня был какой-то допотопный! 47 не пробовал не разобрался что к чему!

SergAM243 · 16.12.2008, 13:25

Большое спасибо за код! Сам пищу, а кому показал из теток пищат еще громче! Подскажите пожалуйста, что надо изменить в коде #25, чтобы задать вес линии и ее тип при создании слоев? Заранее спасибо!

andrew_ro · 17.12.2008, 14:30

SergAM243,
Находишь в тексте программы строку

Цитата:

(vl-cmdf "_layer" "_make" "Размеры" "_color" 151 "" "") ;_Создаем слой размеры и задаем цвет 151 ...

и дополняешь ее таким образом

Цитата:

(vl-cmdf "_layer" "_make" "Размеры" "_color" 151 "" "_lw" 0.13 "" "") ;_Создаем слой размеры и задаем цвет 151 ...

Можно посмотреть коментарии в коде Алексея (#47), там оформление немного другое, но достаточно подробно расписано, что к чему.

SergAM243 · 17.12.2008, 14:57

Спасибо за ответ! Код #47 я просматривал, про "_lw" догадался, но пытался вставить команду внутрь одной из пары двойных заключительных кавычек. В результате я получил почти то, что хотел. Только по окончанию кода он (АКад) на меня ругался и требовал завершения команды.После Вашего ответа понял, что я неправильно делал. Еще раз спасибо!!!

andrew_ro · 18.12.2008, 09:06

Цитата:

Сообщение от SergAM243,
Сам пищу, а кому показал из теток пищат еще громче!

Есть у меня еще задумка соединить код #25 (или #47) с кодами из этой темы. Но боюсь эта задача подсилу только мэтрам программирования. Думаю ваши тетки запищат еще сильнее.

bridgeconst · 18.12.2008, 09:48

Мне кажется, что пора переименовывать тему в "Как заставить теток сильно пищать?"

SergAM243 · 18.12.2008, 14:07

Считаю это явно излишним менять цвет курсора под слой! Для мэтров - это конечно интересная задача! А для работы, когда курсор меняет цвет , как ... простите не знаю как обозвать, думаю не будет большой информативности. А если слоев не 22, как у меня, а, как некоторые здесь указывали, за 100? В этих ста оттенках курсора разобраться и запомнить их , по-моему нереально!

andrew_ro · 18.12.2008, 15:59

Цитата:

Сообщение от SergAM243,
...А если слоев не 22, как у меня, а, как некоторые здесь указывали, за 100?

Вообще можно слои с оттенками одного цвета назначать однотипным объектам и при помощи курсора контролировать работу над той или иной группой объектов. Все зависит от привычки. Но в целом согласен - при большом количестве слоев преимущества спорны.

SergAM243 · 18.12.2008, 16:14

А пользу от #25 и #47(в котором я не смог правда разобраться) вижу в том, что можно их (даже насильно) подсунуть в автозагрузку "тетушке", один день выслушать все-все-все, пожимая плечами, и наблюдать как через неделю-другую они привыкнут к хорошему. И будет положено начало хоть какого-то порядка в чертежах! А то все слой 0 и стили текста и размеров STANDARD (под которыми скрывается все,что хочешь)!

SergAM243 · 18.12.2008, 16:15

Правда это уже другая тема!!!

zenon · 18.12.2008, 16:29

Offtop:

Цитата:

Сообщение от SergAM243

А пользу от #25 и #47(в котором я не смог правда разобраться) вижу в том, что можно их (даже насильно) подсунуть в автозагрузку "тетушке", один день выслушать все-все-все, пожимая плечами, и наблюдать как через неделю-другую они привыкнут к хорошему. И будет положено начало хоть какого-то порядка в чертежах! А то все слой 0 и стили текста и размеров STANDARD (под которыми скрывается все,что хочешь)!

а после того как привыкнут, поотрубать нахрен, дабы прочуствовали

Михаил055 · 22.12.2008, 00:31

Раньше при простановке размеров они сами создавались на слое "Dim". Но размеры написал сам. Теперь некоторые использую штатные. Линейные и угловые. Чтобы они тоже были на слое "Dim" сделал пунккт меню, с помощью которого запускаю функцию пересылающую все размеры на этот слой. Делаю это периодически или в конце работы.

Функция вот такая:

(defun CHGL_dim ()
(setvar "cmdecho" 0)
(setq Ss1 (ssget "X"'((0 . "DIMENSION"))))

(setq $lay (getvar "CLAYER"))

(command "_layer" "_m" "dim" "")
(command "_change" Ss1 "" "_prop" "_layer" "dim" "")

(command "_layer" "_set" $lay "")
(princ)
);end CHGL_dim

wetr · 11.06.2009, 03:53

Кулик Алексей aka kpblc, не хочешь улучшить свой реактор? Лисп отличный, тестирую уже 2 год, никаких проблем не было. Ему не хватает только настроек слоев в диалоговом окне.

Кулик Алексей aka kpblc · 11.06.2009, 08:25

И как это должно выглядеть? Само окно.

wetr · 11.06.2009, 09:18

Список элементов, для которых нужно "подставлять" слои.
Каждый элемент списка по умолчанию - "погашен".
Чтобы активировать, нужно поставить галочку напротив. Когда активировали, становится активной вся строка напротив элемента, как в менеджере слоев. Там можно задать настройки и ИМЯ слоя. Если сделаешь - можно смело (рядом с веткадом) выставлять на продажу. Без шуток.

Кулик Алексей aka kpblc · 11.06.2009, 09:47

Тогда получается, что надо предлагать обработку для следующих примитивов:

Отрезок (_.line)
Дуга (_.arc)
Полилиния (_.pline)
Полигон (_.polygon)
3d-полилиния (_.3dpoly)
Мультилиния (_.mline)
Окружность (_.circle)
Эллипс (_.ellipse)
Область (_.region)
Штриховка (_.hatch / _.bhatch)
Однострочный текст (_.text / _.dtext). Дополнительно настройки текстового стиля - требуются или нет?
Многострочный текст (_.mtext). Дополнительно настройки текстового стиля - нужны?
Выноски (_.leader / _.qleader)
Многострочные выноски (_.mleader)
Таблица (_.table)
Извлечение данных (_.dataextraction)
Размеры. Что с настройками размерного стиля?
- Линейные размеры
- Ортогональные размеры
- Параллельные размеры
- Угловые размеры
- Радиусы
- Диаметры
- Выноски и допуски

Определись, какие надо команды обрабатывать и, самое главное - как. Потом уже можно и голову ломать

zenon · 11.06.2009, 10:08

Цитата:

Сообщение от Кулик Алексей aka kpblc

Тогда получается, что надо предлагать обработку для следующих примитивов:

Отрезок (_.line)
Дуга (_.arc)
Полилиния (_.pline)
Полигон (_.polygon)
3d-полилиния (_.3dpoly)
Мультилиния (_.mline)
Окружность (_.circle)
Эллипс (_.ellipse)
Область (_.region)
Штриховка (_.hatch / _.bhatch)
Однострочный текст (_.text / _.dtext). Дополнительно настройки текстового стиля - требуются или нет?
Многострочный текст (_.mtext). Дополнительно настройки текстового стиля - нужны?
Выноски (_.leader / _.qleader)
Многострочные выноски (_.mleader)
Таблица (_.table)
Извлечение данных (_.dataextraction)
Размеры. Что с настройками размерного стиля?
- Линейные размеры
- Ортогональные размеры
- Параллельные размеры
- Угловые размеры
- Радиусы
- Диаметры
- Выноски и допуски

Определись, какие надо команды обрабатывать и, самое главное - как. Потом уже можно и голову ломать

тогда уж так

Отрезок (_.line) - не нужно обрабатывать
Дуга (_.arc) - не нужно обрабатывать
Полилиния (_.pline) - не нужно обрабатывать
Полигон (_.polygon) - не нужно обрабатывать
3d-полилиния (_.3dpoly) - не нужно обрабатывать
Мультилиния (_.mline) - не нужно обрабатывать
Окружность (_.circle) - не нужно обрабатывать
Эллипс (_.ellipse) - не нужно обрабатывать
Область (_.region) - не нужно обрабатывать
Штриховка (_.hatch / _.bhatch) - обрабатывать
Однострочный текст (_.text / _.dtext). Дополнительно настройки текстового стиля - требуются или нет? - обрабатывать, можно и дополнительнительные настройки ввести, ежели время будет.
Многострочный текст (_.mtext). Дополнительно настройки текстового стиля - нужны? - обрабатывать, можно и дополнительнительные настройки ввести, ежели время будет.
Выноски (_.leader / _.qleader) - обрабатывать
Многострочные выноски (_.mleader) - обрабатывать
Таблица (_.table) - обрабатывать, а можно и оставить на совести юзера
Извлечение данных (_.dataextraction) - обрабатывать, а можно и оставить на совести юзера
Размеры. Что с настройками размерного стиля?
- - - обрабатывать, а вот по настройкам..., думаю можно и позаморачитваться, хотя лучше это все через шаблон оставить на откуп юзеру
- Линейные размеры
- Ортогональные размеры
- Параллельные размеры
- Угловые размеры
- Радиусы
- Диаметры
- Выноски и допуски

Кулик Алексей aka kpblc · 11.06.2009, 10:09

Ок, попробую на выходных время выкроить...

Piton · 11.06.2009, 12:55

Как вариант программа FLAY
http://www.xanadu.cz/dl_file.asp?ID=860

gipro · 11.06.2009, 14:18

Кстати, об VetCAD... Я активно пользуюсь его инструментами "сварка" (считаю их куда более удачными, чем СПДС). Помогите заставить их отрисовываться на соответствующем слое... Сам пользуюсь кодом из 25-го поста. Подскажите, что и куда там добавить.

wetr · 11.06.2009, 14:50

Кулик Алексей aka kpblc, еще можно вьюпорты обрабатывать. На вырост, можно и мультилинии добавлять. Если имя слоя брать из Стиля мультилинии.

Positron · 05.01.2010, 15:25

Добрый день!

Хотел спросить, а как в код добавить авто определение стиля размера:
чтоб определяло какой именно стиль размера и тогда кидало на заданный слой.

Причиной тому есть то что я работаю имея для каждого стиля свой слой.

nik_mb · 05.01.2010, 21:05

Цитата:

Сообщение от Positron

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

Просто. Вставить такой кусок кода вместо написанного:

Код:

[Выделить все]

 (defun cmd-start (react	cmd / selset   cmd_name ent
		  svr res tag text index _attreq_  _attdia_
		  )
  (setq cmd_name (strcase (car cmd) t))
(setq *dim_style* (strcase (getvar "dimstyle")));;ДОБАВИТЬ ЭТУ СТРОКУ
;; для определения текущего размерного стиля
(cond
 ((vl-string-search "dim" cmd_name)
  (setq *vlr-settings*
	(list (cons "layer"
		    (vla-get-activelayer *kpblc-activedoc*)
		    ) ;_ end of cons
  	(cons "color" (getvar "cecolor"))
	(cons "lw" (getvar "celweight"))
	(cons "lt" (getvar "celtype")) ) ;_ end of list
	   ) ;_ end of setq
;;НАЧАЛО ВСТАВКИ. "DIM_ONE", "DIM_TWO" и "DIM_THREE" - имеющиеся размерные стили
(cond
((= *dim_style* "DIM_ONE") ;; для первого стиля размеров, писать всеми заглавными
 (vla-put-activelayer *kpblc-activedoc*
   (_kpblc-layer-create
     '(("name" . "Размеры_one");;Имя слоя для первого стиля размеров "dim_one"
       ("color" . 140)
       ("lw" . 20) )
     )
   )
 )
((= *dim_style* "DIM_TWO") ;; для второго стиля
 (vla-put-activelayer *kpblc-activedoc*
   (_kpblc-layer-create
     '(("name" . "Размеры_two")
       ("color" . 140)
       ("lw" . 20)
       )
     )
   )
 )
((= *dim_style* "DIM_THREE") ;; и еще для одного
 (vla-put-activelayer *kpblc-activedoc*
   (_kpblc-layer-create
     '(("name" . "Размеры_three")
       ("color" . 140)
       ("lw" . 20)
       )
     )
   )
 )
;; и т.д и т.п. сколько есть стилей
);;cond 
;; КОНЕЦ ВСТАВКИ
 (mapcar 'setvar
	 '("cecolor" "celweight" "celtype")
	 '("bylayer" -1 "bylayer")
	 ) ;_ end of mapcar
...

Positron · 06.01.2010, 18:11

Цитата:

Сообщение от nik_mb

Просто. Вставить такой кусок кода вместо написанного:

Код:

[Выделить все]

(defun cmd-start (react	cmd / selset   cmd_name ent
		  svr res tag text index _attreq_  _attdia_
		  )
  (setq cmd_name (strcase (car cmd) t))
(setq *dim_style* (strcase (getvar "dimstyle")));;ДОБАВИТЬ ЭТУ СТРОКУ
;; для определения текущего размерного стиля
(cond
 ((vl-string-search "dim" cmd_name)
  (setq *vlr-settings*
	(list (cons "layer"
		    (vla-get-activelayer *kpblc-activedoc*)
		    ) ;_ end of cons
  	(cons "color" (getvar "cecolor"))
	(cons "lw" (getvar "celweight"))
	(cons "lt" (getvar "celtype")) ) ;_ end of list
	   ) ;_ end of setq
;;НАЧАЛО ВСТАВКИ. "DIM_ONE", "DIM_TWO" и "DIM_THREE" - имеющиеся размерные стили
(cond
((= *dim_style* "DIM_ONE") ;; для первого стиля размеров, писать всеми заглавными
 (vla-put-activelayer *kpblc-activedoc*
   (_kpblc-layer-create
     '(("name" . "Размеры_one");;Имя слоя для первого стиля размеров "dim_one"
       ("color" . 140)
       ("lw" . 20) )
     )
   )
 )
((= *dim_style* "DIM_TWO") ;; для второго стиля
 (vla-put-activelayer *kpblc-activedoc*
   (_kpblc-layer-create
     '(("name" . "Размеры_two")
       ("color" . 140)
       ("lw" . 20)
       )
     )
   )
 )
((= *dim_style* "DIM_THREE") ;; и еще для одного
 (vla-put-activelayer *kpblc-activedoc*
   (_kpblc-layer-create
     '(("name" . "Размеры_three")
       ("color" . 140)
       ("lw" . 20)
       )
     )
   )
 )
;; и т.д и т.п. сколько есть стилей
);;cond 
;; КОНЕЦ ВСТАВКИ
 (mapcar 'setvar
	 '("cecolor" "celweight" "celtype")
	 '("bylayer" -1 "bylayer")
	 ) ;_ end of mapcar
...

Спасибо что откликнулся!

Проверил, но почемуто не работает, говорю что делал:
Закинул в автозапуск, создал как в примере
слой DIM_TWO и стиль Размеры_two
чтоб проверить работоспособность...
подставлял и свои, но не работает ни один.

Возможно я чо не так сделал?

nik_mb · 06.01.2010, 22:25

Полностью исправленный лисп-файл (правда, мною немного поковерканый) и чертеж-двг, как пример.
Пробуй. У меня работает.

Positron · 09.02.2010, 14:18

Цитата:

Сообщение от nik_mb

Полностью исправленный лисп-файл (правда, мною немного поковерканый) и чертеж-двг, как пример.
Пробуй. У меня работает.

Запустил чертёж, там работают твои слоя и стили, но как непойму, я перед этим лисп даже не загрузил в автокад...
Когда загрузил в автозагрузку лисп со своими натсройками(красным), то оно неработает:

Код:

[Выделить все]

 ;; Перенесение заданных примитивов (размеры, штриховка, текст) на заданный слой

(if (not ActiveDocument)
  (setq ActiveDocument (vla-get-ActiveDocument (vlax-get-acad-object)))
 ) ;_ end of if

(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-cancel)
		      (:vlr-commandfailed . cmd-fail)
		      )
		    ) ;_ end of VLR-Command-Reactor
	) ;_ end of setq
  ) ;_ end of if
;; Функция подгрузки типа линии - на http://www.autocad.ru/cgi-bin/f1/board.cgi?t=22730iW

;|=============================================================================
*    Создание слоя с указанными параметрами.
*    Возвращает vla-указатель на созданный слой. Если слой существует, его
* настройки приводятся в соответствие с переданным списком.
*   layer-list   список параметров слоя вида:
   '(("name" . "TestLayer")   ; имя слоя. Не может быть пропущено
   ("color" . 3)         ; номер цвета. nil -> 7
   ("lw" . 50)         ; вес линии слоя. nil -> 25
   ("lt" . "hidden")      ; тип линии слоя. nil -> Continuous
               ; Если описания типа линии в acadiso.lin
               ; нет, обязательно указывать следующий
               ; параметр
   ("ltfile" . "c:\\cad\\ltypes\\lt.lin")   ; полный путь к файлу с описанием
               ; типа линии. Если файл находится в путях
               ; поддержки, путь можно не указывать
   ("plot" . "y")         ; Печатать ("y") или нет ("n") слой.
               ; nil -> "y"
   )
*    Слой размораживается, разблокируется и включается. Не активируется.
|;
(defun _kpblc-layer-create (layer-list / vla_layer)
(setq vla_layer (vla-add (vla-get-layers ActiveDocument)
	   (cdr (assoc "name" layer-list))
	   ) ;_ end of vla-add
	) ;_ end of setq
  (vla-put-color vla_layer 
    (if	(cdr (assoc "color" layer-list))
      (cdr (assoc "color" layer-list))
      7
      ) ;_ end of if
    ) ;_ end of vla-put-color
  (vla-put-lineweight
    vla_layer
    (if	(cdr (assoc "lw" layer-list))
      (cdr (assoc "lw" layer-list))
      aclnwt025
      ) ;_ end of if
    ) ;_ end of vla-put-lineweight
  (if (and (cdr (assoc "lt" layer-list))
	   (_kpblc-linetype-load
	     (cdr (assoc "lt" layer-list))
	     (cdr (assoc "ltfile" layer-list))
	     ) ;_ end of _kpblc-linetype-load
	   ) ;_ end of and
    (vla-put-linetype vla_layer (cdr (assoc "lt" layer-list)))
    (vla-put-linetype vla_layer "Continuous")
    ) ;_ end of if
  (vla-put-plottable
    vla_layer
    (if	(= (cdr (assoc "plot" layer-list)) "n")
      :vlax-false
      :vlax-true
      ) ;_ end of if
    ) ;_ end of vla-put-Plottable
  (vla-put-lock vla_layer :vlax-false)
  (vla-put-layeron vla_layer :vlax-true)
  (if (not (equal (vla-get-activelayer ActiveDocument)
		  vla_layer
		  ) ;_ end of equal
	   ) ;_ end of not
    (vla-put-freeze vla_layer :vlax-false)
    ) ;_ end of if
  vla_layer
  ) ;_ end of defun

(defun cmd-start (react	cmd / selset   cmd_name ent
		  svr res tag text index _attreq_  _attdia_
		  )
  (setq cmd_name (strcase (car cmd) t))
(setq *dim_style* (strcase (getvar "dimstyle")))
(cond
((vl-string-search "dim" cmd_name)(setq *vlr-settings* (list (cons "layer" (vla-get-activelayer ActiveDocument)) ;_ end of cons
  	(cons "color" (getvar "cecolor"))
	(cons "lw" (getvar "celweight"))
	(cons "lt" (getvar "celtype")) ) ;_ end of list
	   ) ;_ end of setq
(cond
((= *dim_style* "01_1x1")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x1)")("color" . 140)("lw" . 20)))))
((= *dim_style* "02_1x2")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x2)")("color" . 140)("lw" . 20)))))
((= *dim_style* "03_1x4")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x4-5)")("color" . 140)("lw" . 20)))))
((= *dim_style* "04_1x5")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x4-5)")("color" . 140)("lw" . 20)))))
((= *dim_style* "05_1x8")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х08-10)")("color" . 140)("lw" . 20)))))
((= *dim_style* "06_1x10")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х08-10)")("color" . 140)("lw" . 20)))))
((= *dim_style* "07_1x16")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х16-20)")("color" . 140)("lw" . 20)))))
((= *dim_style* "08_1x20")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х16-20)")("color" . 140)("lw" . 20)))))
((= *dim_style* "09_1x30")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))
((= *dim_style* "10_1x40")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))
((= *dim_style* "11_G1x1")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))
);;cond
(mapcar 'setvar '("cecolor" "celweight" "celtype") '("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ((vl-string-search "hatch" cmd_name)(setq *vlr-settings*
	    (list (cons	"layer" (vla-get-activelayer ActiveDocument)	) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "Штриховка")("color" . 190)("lw" . 15)) ) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar '("cecolor" "celweight" "celtype")'("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ((vl-string-search "text" cmd_name)
     (setq *vlr-settings* (list (cons	"layer" (vla-get-activelayer ActiveDocument)	) ;_ end of cons
		  (cons "color" (getvar "cecolor"))
		  (cons "lw" (getvar "celweight"))
		  (cons "lt" (getvar "celtype"))
		  ) ;_ end of list
	   ) ;_ end of setq
     (vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "Текст")("color" . 150)("lw" . 25))) ;_ end of _kpblc-layer-create
       ) ;_ end of vla-put-ActiveLayer
     (mapcar 'setvar '("cecolor" "celweight" "celtype") '("bylayer" -1 "bylayer")) ;_ end of mapcar
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-end (react  cmd  / list_obj selset  item counter leader_item cmd_name
		leader_item_list up_string low_string )
  (setq	cmd_name (strcase (car cmd) t) 	counter	 0 ) ;_ end of setq
  (cond
    ((or (vl-string-search "dim" cmd_name)
	 (vl-string-search "text" cmd_name)
	 (vl-string-search "hatch" cmd_name)
	 ) ;_ end of or
     (if *vlr-settings*
       (progn
	 (vla-put-activelayer
	   ActiveDocument
	   (cdr (assoc "layer" *vlr-settings*))
	   ) ;_ end of vla-put-ActiveLayer
	 (mapcar 'setvar
		 '("cecolor" "celweight" "celtype")
		 (list (cdr (assoc "color" *vlr-settings*))
		       (cdr (assoc "lw" *vlr-settings*))
		       (cdr (assoc "lt" *vlr-settings*))
		       ) ;_ end of list
		 ) ;_ end of mapcar
	 (setq *vlr-settings* nil)
	 ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

(defun cmd-cancel (react cmd / cmd_name)
  (setq cmd_name (strcase (car cmd) t))
  (cond
    ((or (vl-string-search "dim" cmd_name)
	 (vl-string-search "text" cmd_name)
	 (vl-string-search "hatch" cmd_name)
	 ) ;_ end of or
     (if *vlr-settings*
       (progn
	 (vla-put-activelayer
	   ActiveDocument
	   (cdr (assoc "layer" *vlr-settings*))
	   ) ;_ end of vla-put-ActiveLayer
	 (mapcar 'setvar
		 '("cecolor" "celweight" "celtype")
		 (list (cdr (assoc "color" *vlr-settings*))
		       (cdr (assoc "lw" *vlr-settings*))
		       (cdr (assoc "lt" *vlr-settings*))
		       ) ;_ end of list
		 ) ;_ end of mapcar
	 (setq *vlr-settings* nil)
	 ) ;_ end of progn
       ) ;_ end of if
     )
    ) ;_ end of cond
  ) ;_ end of defun

;|=============================================================================
*    Функция подгрузки типа линии в текущий файл. Учитывает возможную
* локализацию системы.
*    Параметры вызова:
*  ltype-name  имя типа линии для английской версии
*  ltype-file  имя файла описания типа линии. nil -> "acadiso.lin"ю
*      Если файл с описанием типа линии не лежит по путям
*      поддержки када, надо указывать полный путь к нему.
*    Примеры вызова:
(_kpblc-linetype-load "center" nil)  ; для русской версии подгружает Осевая и возвращает
                                     ; t при успехе
***  Соответствие наименований линий обеспечивается огромным списком ltype_list
*** который можно и нужно дополнять :) Только надо либо все делать мелкими
*** буквами, либо жестко соблюдать регистр в моменты вызовов.
***  Тип линии "Continuous" обработке не подвергается — он есть во всех версиях
=============================================================================|;
(defun _kpblc-linetype-load
       (ltype-name ltype-file / ltype_normal ltype_list result)
  (vl-load-com)
  (setq	ltype_list '(("center" . "осевая")
		     ("center2" . "осевая2")
		     ("hidden" . "скрытая")
		     ("hidden2" . "скрытая2")
		     )
	ltype-name (strcase ltype-name t)
	) ;_ end of setq
  (if (not ltype-file)
    (setq ltype-file "acadiso.lin")
    ) ;_ end of if
  (if (vl-string-search "419" (vlax-product-key))
    ;; Русская версия, меняем имя типа линии
    (setq ltype_normal (cdr (assoc ltype-name ltype_list)))
    (setq ltype_normal ltype-name)
    ) ;_ end of if
  (if (not (tblsearch "ltype" ltype_normal))
    ;; тип линии не найден, надо его загрузить. Тип линии должен быть
    ;; описан в файле
    (setq result (not (vl-catch-all-error-p
			(vl-catch-all-apply
			  'vla-load
			  (list
			    (vlax-get-property
			      (vla-get-ActiveDocument (vlax-get-acad-object))
			      'linetypes
			      ) ;_ end of vlax-get-property
			    ltype_normal
			    ltype-file
			    ) ;_ end of list
			  ) ;_ end of vl-catch-all-apply
			) ;_ end of vl-catch-all-error-p
		      ) ;_ end of not
	  ) ;_ end of setq
    ) ;_ end of if
  result
  ) ;_ end of defun

nik_mb · 10.02.2010, 20:49

Так писать нельзя. Надо, что бы в программе название слоев были заглавными буквами от того, что строчка у kpblc такая:

Код:

[Выделить все]

(setq *dim_style* (strcase (getvar "dimstyle")))

Поэтому в коде выглядеть должно так:

Код:

[Выделить все]

;; "X" - заглавная латинская икс
((= *dim_style* "01_1X1")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x1)")("color" . 140)("lw" . 20)))))
((= *dim_style* "02_1X2")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x2)")("color" . 140)("lw" . 20)))))
((= *dim_style* "03_1X4")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x4-5)")("color" . 140)("lw" . 20)))))
((= *dim_style* "04_1X5")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1x4-5)")("color" . 140)("lw" . 20)))))
((= *dim_style* "05_1X8")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х08-10)")("color" . 140)("lw" . 20)))))
((= *dim_style* "06_1X10")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х08-10)")("color" . 140)("lw" . 20)))))
((= *dim_style* "07_1X16")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х16-20)")("color" . 140)("lw" . 20)))))
((= *dim_style* "08_1X20")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM (1х16-20)")("color" . 140)("lw" . 20)))))
((= *dim_style* "09_1X30")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))
((= *dim_style* "10_1X40")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))
((= *dim_style* "11_G1X1")(vla-put-activelayer ActiveDocument (_kpblc-layer-create '(("name" . "02 DIM")("color" . 140)("lw" . 20)))))

В самом файле можно называть размерные стили какими угодно буквами

ЗЫ. Как говорил Жванецкий: "Тщательнее надо ребята..."

Positron · 11.02.2010, 14:06

Спасибо, исправил, работает замечательно.

Есть ещо 1-н вопросик, а возможно штоб текст в зависимости от высоты перемещался на слои.

вот по таким параметрам (первый столбик высота текста, после "-слой->" название слоя):

2.5, 3, 4 -слой-> 02 DIM (1x1)
__________________________________________
5, 6, 8 -слой-> 02 DIM (1x2)
__________________________________________
10,12.5,16 -слой-> 02 DIM (1x4-5)
__________________________________________
20, 25 -слой-> 02 DIM (1х08-10)
__________________________________________
40, 50 -слой-> 02 DIM (1х16-20)
__________________________________________
любые другие высоты -слой-> 10 Text

Кулик Алексей aka kpblc · 11.02.2010, 16:43

Такое (в общем случае) будет возможно только по завершении команды. Или писать переопределенную команду.

Positron · 11.02.2010, 17:01

Цитата:

Сообщение от Кулик Алексей aka kpblc

Такое (в общем случае) будет возможно только по завершении команды. Или писать переопределенную команду.

а если забить каждую высоту в определённый стиль текста?
может так?

nik_mb · 11.02.2010, 19:27

Я, в своем "строителе" сделал для текста высотой 2,5мм (команда "текст_м") такой программный перевод на нужный слой (он настраивается). Но прежде небольшое пояснение.
Не нравится мне чертить в видовых экранах на листах (layout). Разбиваю чертеж в пространстве модели на масштабные зоны, управляемые программой через блок с скрытыми атрибутами. В этом блоке записаны масштаб и координаты зоны этого масштаба. Рисуя в той или иной зоне, происходит автоматический переход масштабов для отрисовки оформительских элементов "строителя", текста и размерных стилей (для каждого масштаба определяю свой размерный стиль с заданным глобально масштабом).

Код:

[Выделить все]

(defun c:текст_м (/ pt1 htet1 pr_te prm_te)
  (setvar "cmdecho" 0)
  (vlax-invoke-method activedocument "StartUndoMark")
  (setq old_lay (getvar "clayer"))
  (setvar "celweight" tolsh_29)
  (у_сл_те)
  ;; установка слоя текста
  (if (not msh)
    (progn (masht))
  ) ;_ конец if
  ;; установка заданного масштаба
  (p_mash)
  (setq	pr_te nil
	prm_te nil
  ) ;_ конец setq
  (setq
    pt1	(getpoint "\nНачальная точка текста [Enter - Выравнивание]: ")
  ) ;_ конец setq
  (princ "\n")
  (if pt1
    (progn
      (setq ptum pt1)
      ;; если точка попадает в масштабную зону то переустановить масштаб
      (zmash);; функция определения масштаба по координатам точки pt1
      (setq htet1 (* mshv 2.5));; установить высоту по масштабу
      (setvar "cmdecho" 1)
      (command "_dtext" pt1 htet1 pause)
    ) ;_ конец progn
    (progn
      ;;если не указана точка начала текста
      (initget
	32
	"вписанный поширине центр середина вправо ВЛ ВЦ ВП СЛ СЦ СП НЛ НЦ НП И и П п Ц ц Е е Р р вл вп сл сц сп нл нц нп"
      ) ;_ конец initget
      (setq pr_te
	     (getkword
	       (strcat
		 "\nЗадайте параметр "
		 "\n[впИсанный/Поширине/Центр/сЕредина/впРаво/ВЛ/ВЦ/ВП/СЛ/СЦ/СП/НЛ/НЦ/НП]: "
	       ) ;_ конец strcat
	     ) ;_ конец getkword
      ) ;_ конец setq
      (if pr_te
	(setq prm_te pr_te)
	(setq prm_te "_bl")
      ) ;_ конец if
      (while (not pt1)
	(setq pt1 (getpoint "\nНачальная точка текста: "))
      ) ;_ конец while
      (princ "\n")
      (setq ptum pt1)
      ;; если точка попадает в масштабную зону то переустановить масштаб
      (zmash)
      (setq htet1 (* mshv 2.5))
      (setvar "cmdecho" 1)
      (command "_dtext" "_j" prm_te pt1 htet1 pause)
    ) ;_ конец progn
  ) ;_ конец if
  (setvar "clayer" old_lay)
  (setvar "celweight" old_wgt)
  (vlax-invoke-method activedocument "EndUndoMark")
) ;_ конец defun

(defun у_сл_те ( / s_layer lay_cr v_col)
  ;; установка слоя текста
  (if (and (not (tblsearch "layer" lay_29)) (/= lay_29 "_ByLayer"))
    (progn ;; если такого слоя нет то создать
	   (if (not l_col_te)
	     (progn
	       (princ "\nЦвет слоя ")
	       (princ lay_29)
	       ;; установка настроенного слоя 
	       (princ " голубой <140>?: ")
	       (setq v_col (getint))
	       (if v_col
		 (setq l_col_te v_col)
		 (setq l_col_te 140)
	       ) ;_ конец if
	     ) ;_ конец progn
	   ) ;_ конец if
	   (setq s_layer (vla-get-layers activedocument))
	   (setq lay_cr (vlax-invoke-method s_layer "add" lay_29))
	   (vla-put-color lay_cr l_col_te)
	   (setvar "clayer" lay_29)
    ) ;_ конец progn
    (if	(/= lay_29 "_ByLayer")
      (setvar "clayer" lay_29)
    ) ;_ конец if
    ;; переход на нужный слой
  ) ;_ конец if
) ;_ конец defun

Наделать таких программок для каждой высоты текста можно сколько угодно.

С масшатабными зонами пока не все дается просто. По части переключения размерных стилей, в тех, где требуется выбрать примитив - круг, дугу или линии (размеры угла или радиуса).

milamu · 26.02.2010, 09:15

С недавних пор задалась проблемой, а можно ли командам присвоить слои..Прочитала ваше обсуждение данной проблемы с самого начала и до конца...
Скажу честно, програмист из меня никакой, я ничего не поняла в ваших кодах и лиспах, что и куда вставлять надо....
Ответьте мне пожлста, можно ли профану, такому как я, без кодов и подобных ему..., присваивать командам слои в 2009 акаде?

Profan · 26.02.2010, 09:28

Можно. С помощью палитры инструментов.

andrew_ro · 26.02.2010, 09:35

.. или так (см. .doc файл). Там по выделению цветом все понятно.

milamu · 26.02.2010, 09:38

Цитата:

Сообщение от Profan

Можно. С помощью палитры инструментов.

напишите пжлста как, только по русски, я в английских названиях не разбираюсь

Profan · 26.02.2010, 09:52

Содаете новую палитру инструментов с помощью контекстного меню по щелчку правой кнопкой мыши на пустом месте существующей палитры инструментов. С помощью контекстного меню запускаете Адаптацию палитр. Удерживая нажатой клавишу Ctrl, перетаскиваете любую кнопку с панелей на новую палитру. Далее смотрите и редактируете свойства этого инструмента по правой кнопке мыши.

01.03.2005, 12:58		#1
Автоматический перенос размеров на слой размеры. 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.
Просмотров: 187611