有没有防止lisp修改当前图层的办法？
使用探索者的尺寸标注的时候，经常因为按Esc取消的缘故，造成当前图层从之前的图层变为DIM图层的情况，有没有办法防止因为LISP的编写失误导致自动更改当前图层而变不回去的情况？用反应器应该可以做到，之前我用其它软件的时候会修改我的标注样式，后来我也是用反应器处理好 lch8526 发表于 2018-11-27 11:05
用反应器应该可以做到，之前我用其它软件的时候会修改我的标注样式，后来我也是用反应器处理好
请问lisp如何编写呢？ 我用探索者没有你说的情况 我就是觉得探索者的标注后要多按一次esc很烦，不然不能输入下一条命令，而是修改标注文字，真是弱智 CAD新军 发表于 2018-11-27 14:59
我就是觉得探索者的标注后要多按一次esc很烦，不然不能输入下一条命令，而是修改标注文字，真是弱智
一开始不会出现，但是CAD开时间长了就会有这种情况 本帖最后由 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)标注的时候，自动切换到图层【DIM】，写文字的时候，自动切换图层【TEXT】
页:
[1]