有没有防止lisp修改当前图层的办法？

ljfzx · 发表于 2018-11-27 10:34:35

使用探索者的尺寸标注的时候，经常因为按Esc取消的缘故，造成当前图层从之前的图层变为DIM图层的情况，有没有办法防止因为LISP的编写失误导致自动更改当前图层而变不回去的情况？

lch8526 · 发表于 2018-11-27 11:05:51

用反应器应该可以做到，之前我用其它软件的时候会修改我的标注样式，后来我也是用反应器处理好

ljfzx · 发表于 2018-11-27 14:25:25

lch8526 发表于 2018-11-27 11:05
用反应器应该可以做到，之前我用其它软件的时候会修改我的标注样式，后来我也是用反应器处理好

请问lisp如何编写呢？

CAD新军 · 发表于 2018-11-27 14:58:30

我用探索者没有你说的情况

CAD新军 · 发表于 2018-11-27 14:59:27

我就是觉得探索者的标注后要多按一次esc很烦，不然不能输入下一条命令，而是修改标注文字，真是弱智

ljfzx · 发表于 2018-11-27 16:40:14

CAD新军发表于 2018-11-27 14:59
我就是觉得探索者的标注后要多按一次esc很烦，不然不能输入下一条命令，而是修改标注文字，真是弱智

一开始不会出现，但是CAD开时间长了就会有这种情况

437271963 · 发表于 2018-11-28 10:46:32

本帖最后由 437271963 于 2018-11-28 13:31 编辑

(defun xlr-autolayer_LL ()
(vl-load-com)
;(TextDim)
(setq *doc_doc (vla-get-activedocument (vlax-get-acad-object)))
(setq *lays_lays (vla-get-layers *doc_doc))
(setq *laylst_laylst
'(("DIMANGULAR" "DIM" 3 "continuous" T)
("DIMALIGNED" "DIM" 3 "continuous" T)
("DIMBASELINE" "DIM" 3 "continuous" T)
("DIMCENTER" "DIM" 3 "continuous" T)
("DIMCONTINUE" "DIM" 3 "continuous" T)
("DIMDIAMETER" "DIM" 3 "continuous" T)
("DIMLINEAR" "DIM" 3 "continuous" T)
("DIMORDINATE" "DIM" 3 "continuous" T)
("DIMRADIUS" "DIM" 3 "continuous" T)
("QDIM" "DIM" 3 "continuous" T)
("QLEADER" "DIM" 3 "continuous" T)
("DTEXT" "TEXT" 3 "continuous" T)
("MTEXT" "TEXT" 3 "continuous" T)
("TEXT" "TEXT" 3 "continuous" T)
("DIM" "DIM" 3 "continuous" T)
)
)
(setq OldLayer_OldLayer nil)
(setq *cmdlst_cmdlst (mapcar 'strcase (mapcar 'car *laylst_laylst)))
(mapcar '(lambda (x) (vlr-command-reactor nil x))
(list '((:vlr-commandWillStart . xlr-start))
'((:vlr-commandEnded . xlr-end))
'((:vlr-commandCancelled . xlr-cancel))
)
)
(vlr-editor-reactor
nil
'((:vlr-commandwillstart . xlr-edit))
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-edit (CALL CALLBACK / n)
(foreach N *laylst_laylst
(if (= (strcase (car CALLBACK)) (strcase (car N)))
; 命令反应器返回信息如果与设置的命令相同.
(progn ;建立图层
(apply 'xsetlays (cdr N))
;(setvar "CLAYER" (cadr N));设为当前层.
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-start (calling-reactor xlr-startInfo / n)
(foreach N *laylst_laylst
(if (= (strcase (car xlr-startInfo)) (strcase (car N)))
; 命令反应器返回信息如果与设置的命令相同.
(progn ;建立图层
(apply 'xsetlays (cdr N))
;(setvar "CLAYER" (cadr N));设为当前层.
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-end (calling-reactor xlr-endInfo / cmd)
(setq cmd (car xlr-endInfo))
(if (member cmd *cmdlst_cmdlst)
(if (/= OldLayer_OldLayer nil)
(progn
(setvar "CLAYER" OldLayer_OldLayer)
(setq OldLayer_OldLayer nil)
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-cancel (calling-reactor xlr-cancelInfo / cmd)
(setq cmd (car xlr-cancelInfo))
(if (member cmd *cmdlst_cmdlst)
(if (/= OldLayer_OldLayer nil)
(progn
(setvar "CLAYER" OldLayer_OldLayer)
(setq OldLayer_OldLayer nil)
)
)
)
)
;;;----------------------------------------------------------------------------;;;
;;;----------------------------------------------------------------------------;;;
(defun xsetlays (LAY-NAM COLOR LTYPE plotk / LAYOBJ LTYPESOBJ)
(if (tblobjname "layer" LAY-NAM)
(progn
(if (/= (strcase (getvar "CLAYER"))
(strcase LAY-NAM)
)
(setq OldLayer_OldLayer (getvar "CLAYER"))
(progn
(if (= OldLayer_OldLayer nil)
(setq OldLayer_OldLayer LAY-NAM)
)
)
)
(setvar "CLAYER" lay-nam)
)
(progn ;添加图层.
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-add (list *lays_lays LAY-NAM))
)
(setq LAYOBJ (vla-item *lays_lays LAY-NAM))
(if (not (tblobjname "ltype" LTYPE)) ;添加线型.
(progn
(setq LTYPESOBJ (vla-get-linetypes *doc_doc))
(vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
;>>>　要加强，在多个*.lin寻找
(vlax-release-object LTYPESOBJ)
)
) ;解冻(如冻结)，解锁,设图层为当前,设图层颜色，可打印特性.
(vla-put-layeron layobj :vlax-true)
(vla-put-lock layobj :vlax-false)
(if (= (strcase (getvar "CLAYER")) (strcase lay-nam)) ;解冻.
(vla-put-freeze layobj :vlax-false)
)
(vla-put-color layobj color)
(vla-put-linetype layobj LTYPE)
(vla-put-plottable
layobj
(if plotk
:vlax-true
:vlax-false
)
)
)
)
)
(xlr-autolayer_LL)

(defun xlr-autolayer_LL () 
  (vl-load-com) 
  ;(TextDim) 
  (setq *doc_doc (vla-get-activedocument (vlax-get-acad-object))) 
  (setq *lays_lays (vla-get-layers *doc_doc)) 
  (setq  *laylst_laylst 
   '(("DIMANGULAR" "DIM" 3 "continuous" T) 
     ("DIMALIGNED" "DIM" 3 "continuous" T) 
     ("DIMBASELINE" "DIM" 3 "continuous" T) 
     ("DIMCENTER" "DIM" 3 "continuous" T) 
     ("DIMCONTINUE" "DIM" 3 "continuous" T) 
     ("DIMDIAMETER" "DIM" 3 "continuous" T) 
     ("DIMLINEAR" "DIM" 3 "continuous" T) 
     ("DIMORDINATE" "DIM" 3 "continuous" T) 
     ("DIMRADIUS" "DIM" 3 "continuous" T) 
     ("QDIM" "DIM" 3 "continuous" T) 
     ("QLEADER" "DIM" 3 "continuous" T) 
     ("DTEXT" "TEXT" 3 "continuous" T) 
     ("MTEXT" "TEXT" 3 "continuous" T) 
     ("TEXT" "TEXT" 3 "continuous" T) 
     ("DIM" "DIM" 3 "continuous" T) 
   ) 
  ) 
  (setq OldLayer_OldLayer nil) 
  (setq *cmdlst_cmdlst (mapcar 'strcase (mapcar 'car *laylst_laylst))) 
  (mapcar '(lambda (x) (vlr-command-reactor nil x)) 
    (list  '((:vlr-commandWillStart . xlr-start)) 
    '((:vlr-commandEnded . xlr-end)) 
    '((:vlr-commandCancelled . xlr-cancel)) 
    ) 
  ) 
  (vlr-editor-reactor 
    nil 
    '((:vlr-commandwillstart . xlr-edit)) 
  ) 
) 
 
;;;----------------------------------------------------------------------------;;; 
(defun xlr-edit  (CALL CALLBACK / n) 
  (foreach N *laylst_laylst 
    (if  (= (strcase (car CALLBACK)) (strcase (car N))) 
          ; 命令反应器返回信息如果与设置的命令相同. 
      (progn        ;建立图层 
  (apply 'xsetlays (cdr N)) 
          ;(setvar "CLAYER" (cadr N));设为当前层. 
      ) 
    ) 
  ) 
) 
;;;----------------------------------------------------------------------------;;; 
(defun xlr-start (calling-reactor xlr-startInfo / n) 
  (foreach N *laylst_laylst 
    (if  (= (strcase (car xlr-startInfo)) (strcase (car N))) 
          ; 命令反应器返回信息如果与设置的命令相同. 
      (progn        ;建立图层 
  (apply 'xsetlays (cdr N)) 
          ;(setvar "CLAYER" (cadr N));设为当前层. 
      ) 
    ) 
  ) 
) 
;;;----------------------------------------------------------------------------;;; 
(defun xlr-end (calling-reactor xlr-endInfo / cmd) 
  (setq cmd (car xlr-endInfo)) 
  (if (member cmd *cmdlst_cmdlst) 
    (if (/= OldLayer_OldLayer nil) 
       (progn 
           (setvar "CLAYER" OldLayer_OldLayer) 
           (setq OldLayer_OldLayer nil) 
       ) 
    ) 
  ) 
) 
;;;----------------------------------------------------------------------------;;; 
(defun xlr-cancel (calling-reactor xlr-cancelInfo / cmd) 
  (setq cmd (car xlr-cancelInfo)) 
  (if (member cmd *cmdlst_cmdlst) 
    (if (/= OldLayer_OldLayer nil) 
       (progn 
           (setvar "CLAYER" OldLayer_OldLayer) 
           (setq OldLayer_OldLayer nil) 
       ) 
    ) 
  ) 
) 
;;;----------------------------------------------------------------------------;;; 
;;;----------------------------------------------------------------------------;;; 
(defun xsetlays  (LAY-NAM COLOR LTYPE plotk / LAYOBJ LTYPESOBJ) 
 (if (tblobjname "layer" LAY-NAM) 
    (progn 
      (if (/= (strcase (getvar "CLAYER")) 
        (strcase LAY-NAM) 
    ) 
  (setq OldLayer_OldLayer (getvar "CLAYER")) 
  (progn 
    (if (= OldLayer_OldLayer nil) 
      (setq OldLayer_OldLayer LAY-NAM) 
    ) 
  ) 
      ) 
      (setvar "CLAYER" lay-nam) 
    ) 
    (progn        ;添加图层. 
      (vl-catch-all-error-p 
  (vl-catch-all-apply 'vla-add (list *lays_lays LAY-NAM)) 
      ) 
      (setq LAYOBJ (vla-item *lays_lays LAY-NAM)) 
      (if (not (tblobjname "ltype" LTYPE)) ;添加线型. 
  (progn 
    (setq LTYPESOBJ (vla-get-linetypes *doc_doc)) 
    (vla-load LTYPESOBJ LTYPE (findfile "acad.lin")) 
          ;>>>　要加强，在多个*.lin寻找 
    (vlax-release-object LTYPESOBJ) 
  ) 
      )          ;解冻(如冻结)，解锁,设图层为当前,设图层颜色，可打印特性. 
      (vla-put-layeron layobj :vlax-true) 
      (vla-put-lock layobj :vlax-false) 
      (if (= (strcase (getvar "CLAYER")) (strcase lay-nam)) ;解冻. 
  (vla-put-freeze layobj :vlax-false) 
      ) 
      (vla-put-color layobj color) 
      (vla-put-linetype layobj LTYPE) 
      (vla-put-plottable 
  layobj 
  (if plotk 
    :vlax-true 
    :vlax-false 
  ) 
      ) 
    ) 
  ) 
) 
(xlr-autolayer_LL)

标注的时候，自动切换到图层【DIM】，写文字的时候，自动切换图层【TEXT】

账号		自动登录	找回密码
密码			注册

[提问] 有没有防止lisp修改当前图层的办法？

浏览过的版块