AtuoLisp：命令简化

对于一些AtuoCad的命令，我们需要多个步骤才能实现，比如用“Pedit”将多条线段练成一条多段线，而AutoLisp可以帮助我们简化这些多步骤命令。

1、代码部分

;;;-------------------------------------------------------------
;;;命令ZE，将视口缩放至模型中的矩形框
(defun C:ZE () 
  (command "zoom" "end")
  (command pause "end")
(princ))

;;;-------------------------------------------------------------
;;;命令PML，将所有首尾相连的直曲线创建成一条多段线
(defun c:PML()
	(setq pet (getvar "PEDITACCEPT"))
	(setvar "peditaccept" 1) ; 设置系统变量，以免每次都要确认
  (setq ss (ssget '((0 . "ARC,*LINE,LWPOLYLINE,POLYLINE")))) ; 选择直线对象
	(if (and ss)
		(command "_pedit" "m" ss "" "j" "" "")
		)
	(setvar "peditaccept" 0)
	(setvar "PEDITACCEPT" pet)
	(princ))
	
;;;-------------------------------------------------------------
;;;命令GTC，关闭cad选中对象之外的图层
(defun c:GTC ()
  (setq ss (ssget))
  (if ss
    (progn
      (setq selLayer (vla-get-layer (vlax-ename->vla-object (ssname ss 0)))) ; 获取选择对象所在的图层
      (setq layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ; 获取所有图层
      (setq layersCount (vla-get-count layers)) ；获取图层数量
      (setq layerIndex 0)
      (while (< layerIndex layersCount) ; 遍历所有图层，不是对象所在的图层进行关闭
        (setq currentLayer (vla-item layers layerIndex))
        (if (not (equal (vla-get-name currentLayer) selLayer))
          (progn
            (vla-put-LayerOn currentLayer :vlax-false)
          )
        )
        (setq layerIndex (1+ layerIndex))
      )
    )
  )
  (princ))

;;;-------------------------------------------------------------
;;;命令kTC，打开所有图层
(defun c:kTC ()
	(command "layon")
	(princ))

;;;-------------------------------------------------------------
;;;命令SD，锁定所选图层
(defun c:SD (/ ss obj layer)
  (setq ss (ssget))
  (if ss
    (progn
      (setq obj (ssname ss 0))
      (setq objdata (entget obj)) ; 获取对象的DXF数据
      (setq layer (cdr (assoc 8 objdata))); 获取对象所在的图层名
      (if (tblsearch "LAYER" layer)
        (progn
          (setq layerdata (entget (tblobjname "LAYER" layer)))
          (setq layerdata (subst (cons 70 (logior 4 (cdr (assoc 70 layerdata))))
                                 (assoc 70 layerdata) layerdata)); 锁定图层 - DXF代码 70, 设置第二位为1
          (setq layerdata (subst (cons 440 104)
                                 (assoc 440 layerdata) layerdata)); 设置图层淡显 - DXF代码 440, 淡显40%为104
          (entmod layerdata) ; 更新图层的数据
          (command-s "REGEN")
          (princ (strcat "\n图层 \"" layer "\" 已被锁定"))
        )
        (princ "\n图层不存在！.")
      )
    )
    (princ "\n没有元素被选中，命令取消！.")
  )
  (princ))

;;;-------------------------------------------------------------
;;;命令unlock，解锁全部图层
(defun c:UL (/ layer-list layer-name)
  (setq layer-list (tblnext "LAYER" T))
  (while layer-list
    (setq layer-name (cdr (assoc 2 layer-list))) ; 获取图层名称
    (setq layer-list (entget (tblobjname "LAYER" layer-name))) ; 获取图层的DXF数据
    (if (/= 0 (logand (cdr (assoc 70 layer-list)) 4)) ; 如果第二位是1，则图层被锁定
      (progn
        (setq layer-list (subst (cons 70 (logand (cdr (assoc 70 layer-list)) -5))
                                (assoc 70 layer-list) layer-list))
        (entmod layer-list)
      )
    )
    (setq layer-list (tblnext "LAYER"))
  )
  (command-s "REGEN")
  (princ "\n所有图层已解锁.")
  (princ) ; 正常结束函数
)

;;;-------------------------------------------------------------
;;;命令yc，隐藏所选对象
(defun c:YC ()
	(setq obj (ssget)) ; 获取对象
  (command "_.hideobjects" obj ""))

;;;-------------------------------------------------------------
;;;命令JCYC，解除隐藏所选对象
(defun c:JCYC ()
  (command "_UnIsolateObjects"))

;;;-------------------------------------------------------------
;;;命令QL，清理cad
(defun c:QL()
  (dictremove (namedobjdict)"ACAD_DGNLINESTYLECOMP")
  (command "-purge" "a" "*" "n" "audit" "y")
  (princ "图纸清理完成"))

2、如何使用

        复制代码并以“.lsp”为后缀保存文件，在AutoCad中输入“APPLOAD”，找到并加载该文件即可。