lisp调用qleader端点_标注时自动切换到DIM图层 lisp程序
標(biāo)注時(shí)自動(dòng)切換到DIM圖層
[code=lisp](defun xlr-autolayer ()
;??(setvar "cmdecho" 0)
;??(if (null (tblsearch "layer" "text"))
;? ? (set_layer_list "text" 3 "continuous")
;??)
;??(if (null (tblsearch "layer" "dim"))
;? ? (set_layer_list "dim" 3 "continuous")
;??)
(vl-load-com)
;; 圖層初始化列表 內(nèi)容：commands layers color linetype plottable
(setq *doc (vla-get-activedocument (vlax-get-acad-object)))
(setq *lays (vla-get-layers *doc))
(setq? ? ? ? *laylst
(list (list "DIMANGULAR" "DIM" 3 "continuous" T)
(list "DIMALIGNED" "DIM" 3 "continuous" T)
(list "DIMBASELINE" "DIM" 3 "continuous" T)
(list "DIMCENTER" "DIM" 3 "continuous" T)
(list "DIMCONTINUE" "DIM" 3 "continuous" T)
(list "DIMDIAMETER" "DIM" 3 "continuous" T)
(list "DIMLINEAR" "DIM" 3 "continuous" T)
(list "DIMORDINATE" "DIM" 3 "continuous" T)
(list "DIMRADIUS" "DIM" 3 "continuous" T)
(list "QDIM" "DIM" 3 "continuous" T)
(list "QLEADER" "DIM" 3 "continuous" T)
(list "DTEXT" "TEXT" 3 "continuous" T)
(list "MTEXT" "TEXT" 3 "continuous" T)
(list "TEXT" "TEXT" 3 "continuous" T)
;(list "BHATCH" "填充" 9 "continuous" T)
;(list "HATCH" "填充" 9 "continuous" T)
;(list "POINT" "點(diǎn)" 4 "continuous" T)
;(list "XLINE" "輔助線" 8 "continuous" T)
;(list "LINE" "0" NIL "continuous" T)
;(list "XREF" "引用" 7 "continuous" T)
;(list "pline" "多義線" 2 "center" T)
)
)
(setq OldLayer nil)
(setq *cmdlst (mapcar 'strcase (mapcar 'car *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 /)
(foreach N *laylst
(if? ? ? ? (= (strcase (car CALLBACK)) (strcase (car N)))
; 命令反應(yīng)器返回信息如果與設(shè)置的命令相同.
(progn? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ;建立圖層
(apply 'xsetlays (cdr N))
;(setvar "CLAYER" (cadr N));設(shè)為當(dāng)前層.
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-start (calling-reactor xlr-startInfo /)
(foreach N *laylst
(if? ? ? ? (= (strcase (car xlr-startInfo)) (strcase (car N)))
; 命令反應(yīng)器返回信息如果與設(shè)置的命令相同.
(progn? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ;建立圖層
(apply 'xsetlays (cdr N))
;(setvar "CLAYER" (cadr N));設(shè)為當(dāng)前層.
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-end (calling-reactor xlr-endInfo / cmd)
(setq cmd (car xlr-endInfo))
(if (member cmd *cmdlst)
(if (/= oldlayer nil)
(progn
(setvar "CLAYER" OldLayer)
(setq OldLayer nil)
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-cancel (calling-reactor xlr-cancelInfo / cmd)
(setq cmd (car xlr-cancelInfo))
(if (member cmd *cmdlst)
(if (/= oldlayer nil)
(progn
(setvar "CLAYER" OldLayer)
(setq 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 (getvar "CLAYER"))
(progn
(if (= oldlayer nil)
(setq OldLayer LAY-NAM)
)
)
)
(setvar "CLAYER" lay-nam)
)
(progn? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ;添加圖層.
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-add (list *lays LAY-NAM))
)
(setq LAYOBJ (vla-item *lays LAY-NAM))
(if (not (tblobjname "ltype" LTYPE)) ;添加線型.
(progn
(setq LTYPESOBJ (vla-get-linetypes *doc))
(vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
;>>> 要加強(qiáng)，在多個(gè)*.lin尋找
(vlax-release-object LTYPESOBJ)
)
)? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ;解凍(如凍結(jié))，解鎖,設(shè)圖層為當(dāng)前,設(shè)圖層顏色，可打印特性.
(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)? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ;加載啟動(dòng)!
(princ "\n ----命令圖層反應(yīng)器已加載----")
[/code]
總結(jié)
以上是生活随笔為你收集整理的lisp调用qleader端点_标注时自动切换到DIM图层 lisp程序的全部?jī)?nèi)容，希望文章能夠幫你解決所遇到的問題。
- 上一篇： vue elementui 引入第三方i
- 下一篇： AMD R9 7900X3D 现身《奇点