[LISP函数]：自编cad简化命令

stabb

(defun s::startup()
    (command "_vbaload" "KKSCTDC.dvb")
    (command "_vbarun" "CreateToolBar")
)

;;;简化系统命令见ACAD.PGP
(defun C:S()  (COMMAND "STRETCH" "C"))
(defun C:EE() (COMMAND "PEDIT"))
(defun C:ZA() (COMMAND "ZOOM" "All"))
(defun C:ZD() (COMMAND "ZOOM" "Dynamic"))
(defun C:ZE() (COMMAND "ZOOM" "Extents"))
(defun C:ZZ() (COMMAND "ZOOM" "Previous"))
(defun C:ZW() (COMMAND "ZOOM" "Window"))
(defun c:pm() (command "pedit" "m"))
(defun C:DE() (COMMAND "ddedit" ))
(defun C:C() (COMMAND "COPY"))
(defun C:Cl() (COMMAND "ClOse"))
(defun C:CC() (COMMAND "CIRCLE"))
(defun C:MI() (COMMAND "MIRROR"))
(defun C:RO() (COMMAND "ROTATE"))
(defun C:SC() (COMMAND "SCALE"))
(defun C:A() (COMMAND "ARC"))
(defun C:CV() (COMMAND "CLOSE"))
(defun C:DU() (COMMAND "_polygon"))
(defun C:AR() (COMMAND "ARRAY"))
(defun C:E() (COMMAND "ERASE"))
(defun C:S() (COMMAND "STRETCH"))
(defun C:B() (COMMAND "BREAK"))
(defun C:dbx() (COMMAND "_polygon"))
(defun C:Bl() (COMMAND "Block"))
(defun C:ds() (COMMAND "_dimstyle"))
(defun C:X() (COMMAND "EXPLODE"))
(defun C:F() (COMMAND "FILLET"))
(defun C:CH() (COMMAND "CHAMFER"))
(defun C:P() (COMMAND "'PAN"))
(defun C:L() (COMMAND "LINE"))
(defun C:Q() (COMMAND "QSAVE"))
(defun C:R() (COMMAND "Rotate"))
(defun C:Re() (COMMAND "Redraw"))
(defun C:T() (COMMAND "TRIM"))
(defun C:EX() (COMMAND "EXTEND"))
(defun C:D() (COMMAND "'DIST"))
(defun C:DP() (COMMAND "'_ID"))
(defun C:SE() (COMMAND "SPELL"))
(defun C:OP() (COMMAND "OPEN"))
(defun C:V() (COMMAND "MOVE"))
(defun C:3DC() (COMMAND "3DCORBIT"))
(defun C:3DD() (COMMAND "3DORBIT"))
(defun C:TY() (COMMAND "ellipse"))
(defun C:RT() (COMMAND "RECTANG"))
(defun C:GR() (COMMAND "GROUP"))
(defun C:ss() (COMMAND "'_matchprop"))
(defun C:Da() (COMMAND "dimaligned"))
(defun C:Dg() (COMMAND "dimangular"))
(defun C:YU() (COMMAND "_revcloud"))
(defun C:Db() (COMMAND "DIMBASELINE"))
(defun C:Dc() (COMMAND "DIMCONTINUE"))
(defun C:Dr() (COMMAND "DIMLINEAR"))
(defun C:Dd() (COMMAND "DIMdiameter"))
(defun C:De() (COMMAND "_dimedit" "_o"))
(defun C:Ddr() (COMMAND "DIMradius"))
(defun C:MT() (COMMAND "MIRRTEXT"))
(defun C:PU() (COMMAND "PURGE" "All" "*" "N")


;;;CHT1命令用于替换所选文本中的字符串
(defun C:CHT1(/ p l n e os as ns st s nsl osl sl si chf chm olderr)
(setq olderr  *error*             ; Initialize variables
*error* chgterr
chm     0)
(prompt "\nReplace Part String of  the old  text with new\n")
(setq p (ssget))                  ; Select objects
(if p (progn                      ; If any objects selected
(while (= 0 (setq osl (strlen (setq os (getstring t "\nOld string: ")))))
(princ "Null input invalid")
)
(setq nsl (strlen (setq ns (getstring t "\nNew string: "))))
(setq l 0 n (sslength p))
(while (< l n)                 ; For each selected object...
(if (= "TEXT"               ; Look for TEXT entity type (group 0)
(cdr (assoc 0 (setq e (entget (ssname p l))))))
(progn
(setq chf nil si 1)
(setq s (cdr (setq as (assoc 1 e))))
(while (= osl (setq sl (strlen
(setq st (substr s si osl)))))
(if (= st os)
(progn
(setq s (strcat (substr s 1 (1- si)) ns
(substr s (+ si osl))))
(setq chf t) ; Found old string
(setq si (+ si nsl))
)
(setq si (1+ si))
)
)
(if chf (progn        ; Substitute new string for old
(setq e (subst (cons 1 s) as e))
(entmod e)         ; Modify the TEXT entity
(setq chm (1+ chm))
))
)
)
(setq l (1+ l))
)
))
(princ "Changed ")                ; Print total lines changed
(princ chm)
(princ " text lines.")
(terpri)
(setq *error* olderr)             ; Restore old *error* handler
(princ)
)

;;;CHT2命令用于全部替换所选文本
(defun C:CHT2 ()
(setq olderr  *error*             ; Initialize variables
*error* chgterr
chm     0)
(prompt "\nReplace ALL of  the old Text with new\n")
(setq s (ssget))                  ; Select objects
(setq nc (getstring "\nNew string: "))
(setq ls 0 ns (sslength s) )
(while (< ls ns)
(if (= "TEXT"
(cdr (assoc 0 (setq es (entget (ssname s ls))))))
(progn
(setq ass (assoc 1 es))
(setq es (subst (cons 1 nc) ass es))
(entmod es)
)
)
(setq ls (1+ ls))
)
)

(defun C:CST ( / st ss3 ss4 sn filedi cmdech regenm)
(setq filedi (getvar "FILEDIA"))
(setq cmdech (getvar "CMDECHO"))
(setq regenm (getvar "REGENMODE"))
(setvar "FILEDIA" 0)
(setvar "CMDECHO" 0)
(setvar "REGENMODE" 0)
(setq st (tblnext "STYLE" t))
(while st
(setq ss3 (cdr (assoc 3 st)))
(setq ss4 (cdr (assoc 4 st)))
(setq sn  (cdr (assoc 2 st)))
(if (not (wcmatch sn "*|*"))
(progn
(if (/= ss3 "romans")
(progn
(if (= ss4 "")
(COMMAND "style" (cdr (assoc 2 st)) "romans" "" "" "" "" "" "")
(COMMAND "style" (cdr (assoc 2 st)) "romans
hzfs" "" "" "" "" "" "")
)
)
(progn
(if (and (/= ss4 "hzfs") (/= ss4 ""))
(COMMAND "style" (cdr (assoc 2 st)) "romans
hzfs" "" "" "" "" "" "")
)
)
)
)
)
(setq st (tblnext "STYLE"))
)

(COMMAND "regen")
(setvar "FILEDIA" filedi)
(setvar "CMDECHO" cmdech)
(setvar "REGENMODE" regenm)
'Success!
)

拷贝以上内容，用写字板编辑，另存为acad.lsp，放置在cad安装目录中的support目录中，在autocad中的选项中设置“每个文件均加载acad.lsp”，重新启动autocad即可。