Показать сообщение отдельно
 
Непрочитано 24.02.2006, 15:01
#25
VVA

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


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

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

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

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

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

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

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

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

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

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

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

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

  (princ)
)

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

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

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

Последний раз редактировалось VVA, 21.10.2010 в 20:30. Причина: Новый вариант от Lee Mac
VVA вне форума  
 
Размещение рекламы