贱人工具箱CAD快捷键大全中磊教育

贱人工具箱CAD快捷键大全中磊教育，贱人工具箱是一款非常好用的CAD插件，用的用户很多，那么如果你在使用中不知道某一项指令的快捷键，就来查看此贱人工具箱CAD快捷键大全吧；

(defun c:HH()
(alert"\nＣＤ             线段求和                             ＢＳ             多块同时缩放
\nＡＲＥＡＭ       面积求和                             ＢＴＪ           块统计
\nＤＤＴ           打断插文字                           ＴＴ             合并文字
\nＣ               多重复制                             ＴＴＴ           合并单行文本
\nＣＰ             圆变多边形                           ＴＬ             字按线对齐
\nＣＲ             改多圆半径                           ＸＴ             分解文字
\nＣＭ             沿某方向多重复制                     ＤＸ             改大小写
\nＰＮ             改线弧圆宽度
\nＬＰＮ           按层改线弧圆宽度
\nＣ１～Ｃ９       改颜色
\nＡＮ/０/３０/４５/６０ 旋转绘图角度
\nＺ０             Z轴归零
\nＬＯＣＫＵＰ     加密
\n-----------------------------------------------------------------------------------
\nＬＬ             将所选对象的层变为当前层
\nＬＬＩ           只显示被选对象所在层
\nＬＫ             快速改对象的层
\nＬＪ             解锁图层
\nＱ１/Ｑ２/Ｑ３   关闭/冻结/锁定所选对象所在的层
\nＷ１/Ｗ２/Ｗ３   显示/解冻/解锁全部层
\nＷ１２３         显示+解锁+解冻全部层
\n-----------------------------------------------------------------------------------
\n  
"))
;****************************************************测量长度
(defun c:cd()
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq sum 0 i 0)
(setq ss (ssget))
(repeat (sslength ss)
(setq en (ssname ss i))
(command "lengthen" en "")
(setq l (getvar "perimeter"))
(setq sum (+ sum l)
i (+ i 1))
)
(setvar "osmode" os)
  sum
)
;****************************************************面积求和
(defun c:aream (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
(defun errexit (s)
(restore)
)

(defun undox ()
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)

(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "._UNDO" "_BE")
(if (setq ss1 (ssget '((-4 . "<OR")
(0 . "POLYLINE")
(0 . "LWPOLYLINE")
(0 . "CIRCLE")
(0 . "ELLIPSE")
(0 . "SPLINE")
(0 . "REGION")
(-4 . "OR>")
)
)
)
(progn
(setq nr 0)
(setq tot_area 0.0)
(setq en (ssname ss1 nr))
(while en
(command "._area" "_O" en)
(setq tot_area (+ tot_area (getvar "area")))
(setq nr (1+ nr))
(setq en (ssname ss1 nr))
)
(princ "\n面积之和 = ")
(princ tot_area)
)
)
(restore)
)
;****************************************************打断插文字
(defun c:ddt ()
 (setq th (getdist "\请输入文字高度:"))
 (setq r(* th 1.25))
 (setq t (getstring "请输入要插入的文字:"))
 (setq h1 (entsel))
 (setq h2 (getpoint"\n选择插入点:"))
 (while h2
 (command "circle" h2 r)
 (setq na (entlast))
 (command "trim" na "" h1"")
 (command "text""J""M" h2 th""t)
 (command "erase" na"")
 (setq h1 (entsel))
 (setq h2 (getpoint"\n选择插入点:"))
  )
 )
;****************************************************多重复制
(defun C:C (/ ss FL)
 (princ "\nSelect objects: ")
 (setq ss (ssget))
 (setq n (sslength ss))
 (command "COPY" ss "" "m" "") (repeat n (command "" copy "" ""))
)
;****************************************************圆变多边形
(defun c:cp (/ en n)
  (setvar "cmdecho" 0)
  (setq en (entsel "请选择一个圆"))
  (setq en_data (entget (car en)))
  (setq cen (cdr (assoc 10 en_data)))
  (setq r (cdr (assoc 40 en_data)))
  (setq n (getint "\n请输入正多边形的边数:"))
  (initget "I C")
  (setq    a (getkword "\n输入选项 [内接于圆(I)/外切于圆(C)] <C>:"))
  (if (= a "I")
    (progn
      (command "polygon" n cen "i" r)
    )
    (progn
      (command "polygon" n cen "c" r)
    )
  )
  (command "ERASE" en "")
  (princ)
)
;****************************************************cr改多圆半径
(defun c:cr()
    (setq cm0(getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (princ "\n \n \n")
        (setq r(getdist "请输入半径或<直接回车单个修改>:"))
    (if r (progn
    (setq ss(ssget))
    (while ss
    (setq ll(sslength ss))
    (setq ll0 -1)
    (repeat ll
        (setq ll0(+ ll0 1))
        (setq si(ssname ss ll0))
        (setq cc( entget si))
        (setq ty(cdr (assoc 0 cc)))
        (if (or (= ty "CIRCLE") (= ty "ARC"))
        (progn
        (setq r0(cdr (assoc 40 cc)))
        (setq cc(subst (cons 40 r)(assoc 40 cc)cc))
        (entmod cc)(entupd si)
        ))
     )
     (setq ss(ssget))
     ))
     (progn
    (setq si(entsel "\n选择圆或弧："))
    (while si
        (setq cc(entget (car si)))
        (setq ty(cdr (assoc 0 cc)))
        (if (or (= ty "CIRCLE") (= ty "ARC"))
        (progn
            (setq nm(cdr (assoc -1 cc)))
            (setq r0(cdr (assoc 40 cc)))
            (princ r0)(setq r(getdist "->"))
            (if r (progn
            (setq cc(subst (cons 40 r)(assoc 40 cc)cc))
            (entmod cc)(entupd nm)))
        ))
        (setq si(entsel "\n选择圆或弧："))
    )
     ))
     (setvar "cmdecho" cm0)
)
;****************************************************沿某方向多重复制
(defun C:CM ()
(setq A nil)
(setq OM (getvar "OSMODE"))
(setvar "OSMODE" 33)
(setq PNT1 (getpoint "\n方向起点： "))
(setq PNT2 (getpoint "\n方向终点： " PNT1))(terpri)
(initget 1 "M E N")
(prompt "\n选择复制方式： ")
(setq CTYPE
(getkword "[最大间距(M)/精确间距(E)/数量(N)]： "))
(if (= CTYPE "M")
(setq SP (getdist "\n最大对象间距： ")))
(if (= CTYPE "E")
(setq SP (getdist "\n精确对象间距： ")))
(if (= CTYPE "N")
(setq SP (getreal "\n对象数量： ")))
(setq DIST (distance PNT1 PNT2))
(setq ANG (angle PNT1 PNT2))
(setq TEMP1 (/ DIST SP))
(setq TEMP2 (fix (/ DIST SP)))
(setq INC1 SP)
(setq INC2 (/ DIST (+ 1 (fix (/ DIST SP)))))
(setq INC3 (/ DIST (- SP 1)))
(if (= TEMP1 TEMP2) (setq INC INC1) (setq INC INC2))
(if (= CTYPE "E") (setq INC INC1) (setq INC INC))
(if (= CTYPE "N") (setq INC INC3) (setq INC INC))
(setq TMS (FIX (+ 0.00001 (/ DIST INC))))
(setvar "OSMODE" 0)
(setq A (ssget))
(setq INCR 0)
(repeat TMS
(setq INCR (+ INCR INC))
(setq NEWPT (polar PNT1 ANG INCR))
(command "copy" A "" PNT1 NEWPT)
)
(setvar "OSMODE" OM)
(setq A nil)
)
;****************************************************按层改线弧圆宽度
(defun c:lpn(/ s1 s2 wl n s3 s4 stt)
 (setvar "cmdecho" 0)
 (setq wl (getreal "\n输入线宽："))
 (setq stt (getstring "\n输入需改线宽的层名:"))
 (setq s1 (ssget "X" (list (cons 8 stt))))
  (if s1
  (progn
    (setq n 0)
    (repeat (sslength s1)
      (setq s2 (ssname s1 n))
      (if (= wl 0)     
      (if (or (= "POLYLINE" (cdr (assoc 0 (entget s2))))
               (= "LWPOLYLINE" (cdr (assoc 0 (entget s2))))  )
         (command ^"explode" s2))
      (progn
       (if (= "LINE" (cdr (assoc 0 (entget s2))))
         (command ^"pedit" s2 "y" "w" wl ""))
       (if (= "ARC" (cdr (assoc 0 (entget s2))))
         (command ^"pedit" s2 "y" "w" wl ""))
       (if (or (= "POLYLINE" (cdr (assoc 0 (entget s2))))
               (= "LWPOLYLINE" (cdr (assoc 0 (entget s2))))  )
         (command ^"pedit" s2 "w" wl ""))
      )
      );endif
      (setq n (1+ n))
    )
   )
 )
 (setvar "cmdecho" 1)
)
;****************************************************改线弧圆宽度
(defun C:pn (/ p l n e q w a m b layer0 color0 linetype0 layer1 color1 linetype1 rad-out rad-in)
  (setq oldblp (getvar "blipmode")
        oldech (getvar "cmdecho")
        olderr *error*
        linetype1 (getvar "celtype")
        layer1 (getvar "clayer")
        color1 (getvar "cecolor")
  )
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (defun *error* (msg)
    (princ "\n")
    (princ msg)
    (setvar "blipmode" oldblp)
    (setvar "cmdecho" oldech)
    (setq *error* olderr)
    (princ)
  ) 
  (prompt "\n请选择要改变宽度的线,弧,圆及多义线.")
  (setq p (ssget))
  (setq w (getreal "\n请输入宽度<50>:"))
  (if (not w) (setq w 50))
  (setq l 0 m 0 n (sslength p))
  (while (< l n)
    (setq q (ssname p l))
    (setq ent (entget q))
    (setq b (cdr (assoc 0 ent)))
    (if (member b '("LINE" "ARC"))
      (progn
        (command "PEDIT" q "y" "w" w "x")
        (setq m (+ 1 m))
      )
    )
    (if (= "LWPOLYLINE" b)
      (progn
        (command "PEDIT" q "w" w "x")
        (setq m (+ 1 m))
      )
    )
    (if (= "CIRCLE" b)
      (progn
        (if (assoc 6 ent) (setq linetype0 (cdr (assoc 6 ent))) (setq linetype0 "bylayer"))
        (setq layer0 (cdr (assoc 8 ent)))
        (if (assoc 62 ent) (setq color0 (cdr (assoc 62 ent))) (setq color0 "bylayer"))
        (setq center0 (cdr (assoc 10 ent)))
        (setq radius0 (cdr (assoc 40 ent)))
        (setq diameter0 (* 2 radius0))
        (entdel q)
        (command "color" color0)
        (command "layer" "s" layer0 "")
        (command "linetype" "s" linetype0 "")
        (if (> w diameter0)
          (progn
            (princ "\n\t 因线宽大于圆的直径，故将该圆填充")
            (princ)
            (setq rad-out (* 2 radius0)
                  rad-in 0
            )
          )
        )
        (if (<= w diameter0)
          (progn
            (setq rad-out (+ (* 2 radius0) w)
                  rad-in (- (* 2 radius0) w)
            )
          )
        )
        (command "donut" rad-in rad-out center0 "")
        (setq m (+ 1 m))
      )
    )
    (setq l (+ 1 l))
  )
  (if (= 0 m)
    (progn
     (princ "\n\t  没有任何线,弧,圆及多义线被选中")
      (princ)
    )
  )
  (setvar "blipmode" oldblp)
  (setvar "cmdecho" oldech)
  (setq *error* olderr)
  (command "color" color1)
  (command "layer" "s" layer1 "")
  (command "linetype" "s" linetype1 "")
  (princ)
)
(princ)
;****************************************************改颜色
(DEFUN C:C1 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 1#: ")
    (SETQ SS(SSGET))
    (COMMAND "CHANGE" SS "" "PROPERTIES" "C" "1" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C2 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 2#: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C3 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 3#: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "3" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C4 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 4#: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "4" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C5 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 5#: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "5" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C6 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 6#: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "6" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C7 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 7#: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "7" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C8 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 8#: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "8" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C9 ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color be 9#: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "9" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:CB ()
    (SETVAR "CMDECHO" 0)
    (PRINC "SELECT Obj. Color Bylayer: ")
    (SETQ SS (SSGET))
    (COMMAND "CHPROP" SS "" "C" "BYLAYER" "") (SETVAR "CMDECHO" 1) (PRINC))
;****************************************************旋转绘图角度
(defun c:an()  (command "snapang"))
(defun c:0()   (command "snapang" "0"))
(defun c:30()  (command "snapang" "30"))
(defun c:45()  (command "snapang" "45"))
(defun c:60()  (command "snapang" "60"))
;****************************************************Z轴归零
(defun c:z0()
   (setvar "cmdecho" 0)
   (setvar "blipmode" 0)
   (graphscr)
   (prompt "Z向归零:") (terpri)

   (princ "请选择要归零的实体")
   (setq s (ssget))
   (setq len (sslength s))
   (setq index 0)

   (repeat len
      (setq a (entget (ssname s index)))

      (setq b10 (assoc 10 a))
      (setq b11 (assoc 11 a))

      (setq x10 (cadr b10))
      (setq y10 (caddr b10))

      (setq x11 (cadr b11))
      (setq y11 (caddr b11))

      (setq b101 (cons 10 (list x10 y10 0)))
      (setq b111 (cons 11 (list x11 y11 0)))

      (setq a (subst b101 b10 a))
      (entmod a)
      (setq a (subst b111 b11 a))
      (entmod a)

      (setq index (+ index 1))
   )
   (princ "成功")
   (princ)
)
;****************************************************加密
(defun lockerror (msg)
  (if (/= msg "Function cancelled")
    (princ
      (strcat "\nError: " msg " [" (itoa (getvar "ERRNO")) "]")
    )
    (princ)
  )
  (command "UNDO" "End")
  (Abort "\n加密操作被放弃！")
  (setq *error* olderr)
  (princ)
)

(defun Abort (msg)
  (setvar "filedia" fdia)
  (setvar "cmddia" cdia)
  (setvar "cmdecho" cmd)
  (alert msg)
)
;;Exit

(defun getlayers ()
  (setq lyr (tblnext "layer" t))
  (setq laylist "")
  (while lyr
    (if    (or (and (= (cdr (assoc 62 lyr)) 8)
         (not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
        )
        (and (= (cdr (assoc 62 lyr)) 9)
         (not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
        )
        (and (= (cdr (assoc 62 lyr)) 251)
         (not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
        )
        (and (= (cdr (assoc 62 lyr)) 252)
         (not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
        )
        (and (= (cdr (assoc 62 lyr)) 253)
         (not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
        )
        (and (= (cdr (assoc 62 lyr)) 254)
         (not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
        )
        (and (= (cdr (assoc 62 lyr)) 255)
         (not (wcmatch (cdr (assoc 2 lyr)) "*|*"))
        )
    )
      (if (equal laylist "")
    (setq laylist (strcat laylist (cdr (assoc 2 lyr))))
    (setq laylist (strcat laylist "," (cdr (assoc 2 lyr))))
      )
    )
    (setq lyr (tblnext "layer"))
  )
  laylist
)

(defun backblk (layoutName Mins)
  (if layoutName
    (cond
      ((= layoutName "14MS")
       (setq blist (list '(-4 . "<NOT")
             '(-4 . "<OR")
             '(67 . 1)
             '(0 . "SOLID")
             '(2 . "SOLID")
             '(-4 . "OR>")
             '(-4 . "NOT>")
             '(-4 . "<OR")
             (cons 8 (getlayers))
             '(62 . 8)
             '(62 . 9)
             '(62 . 251)
             '(62 . 252)
             '(62 . 253)
             '(62 . 254)
             '(62 . 255)
             '(-4 . "OR>")
           )
       )
      )
      ((= layoutName "14PS")
       (setq blist (list '(67 . 1)
             '(-4 . "<NOT")
             '(-4 . "<OR")
             '(0 . "SOLID")
             '(2 . "SOLID")
             '(0 . "VIEWPORT")
             '(-4 . "OR>")
             '(-4 . "NOT>")
             '(-4 . "<OR")
             (cons 8 (getlayers))
             '(62 . 8)
             '(62 . 9)
             '(62 . 251)
             '(62 . 252)
             '(62 . 253)
             '(62 . 254)
             '(62 . 255)
             '(-4 . "OR>")
           )
       )
      )
      (T
       (setq blist (list (cons 410 layoutName)
             '(-4 . "<NOT")
             '(-4 . "<OR")
             '(0 . "SOLID")
             '(2 . "SOLID")
             '(0 . "VIEWPORT")
             '(-4 . "OR>")
             '(-4 . "NOT>")
             '(-4 . "<OR")
             (cons 8 (getlayers))
             '(62 . 8)
             '(62 . 9)
             '(62 . 251)
             '(62 . 252)
             '(62 . 253)
             '(62 . 254)
             '(62 . 255)
             '(-4 . "OR>")
           )
       )
      )
    )
    (setq blist    (list '(-4 . "<NOT")
              '(-4 . "<OR")
              '(0 . "SOLID")
              '(2 . "SOLID")
              '(0 . "VIEWPORT")
              '(-4 . "OR>")
              '(-4 . "NOT>")
              '(-4 . "<OR")
              (cons 8 (getlayers))
              '(62 . 8)
              '(62 . 9)
              '(62 . 251)
              '(62 . 252)
              '(62 . 253)
              '(62 . 254)
              '(62 . 255)
              '(-4 . "OR>")
        )
    )
  )
  (setq ssetb (ssget "X" blist))
  (setq viewsset (ssget "X" '((0 . "VIEWPORT"))))
  (if viewsset
    (progn
      (setq n 0)
      (repeat (sslength viewsset)
    (if (setq clipent (assoc 340 (entget (ssname viewsset n))))
      (ssdel (cdr clipent) ssetb)
    )
    (setq n (1+ n))
      )
    )
  )
  (if ssetb
    (progn
      (setq pt (list 0.0 0.0))
      (entmake ;;write block header
           (list '(0 . "BLOCK")
             '(2 . "*anon")
             '(70 . 1)
             (cons '10 pt)
           )
      )
      (setq a 0)
      (repeat (sslength ssetb)
    (setq ent2 (entmake (entget (setq ent (ssname ssetb a)))))
    (if (null ent2)
      (princ (entget (setq ent (ssname ssetb a))))
    )
    (if (assoc 66 (entget ent))
      (progn
        (setq subent (entnext ent))
        (while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
          (entmake (entget subent))
          (setq subent (entnext subent))
        )
        (setq ent3 (entmake (entget subent)))
        (if    (null ent3)
          (princ (entget subent))
        )
      )
    )
    (entdel ent)
    (setq a (1+ a))
    (c:spin "Making Block of background colours..")
      )
      (setq nameb (entmake '((0 . "endblk"))))
      (princ "\n  Inserting...\n")
      (if Mins
    (entmake
      (list    '(0 . "INSERT")
        (CONS '100 "AcDbMInsertBlock")
        (CONS '70 2)
        (CONS '71 2)
        (cons '2 nameb)
        (cons '10 pt)
      )
    )
    (entmake
      (list    '(0 . "INSERT")
        (cons '2 nameb)
        (cons '10 pt)
      )
    )
      )
      (setq bc (entlast))
      (setq bac "back")
      (command "_.draworder" bc "" (strcat "_" bac))
      (setq ssetb nil)
      (setq viewsset nil)
    )
  )
  (princ)
)

(defun solidblk    (layoutName Mins)
  (if layoutName
    (cond
      ((= layoutName "14MS")
       (setq slist (list '(-4 . "<NOT")             '(67 . 1)
             '(-4 . "NOT>")             '(-4 . "<OR")
             '(0 . "SOLID")             '(2 . "SOLID")
             '(-4 . "OR>")
            )
       )
      )
      ((= layoutName "14PS")
       (setq slist (list '(67 . 1)
             '(-4 . "<OR")
             '(0 . "SOLID")
             '(2 . "SOLID")
             '(-4 . "OR>")
           )
       )
      )
      (T
       (setq slist (list (cons 410 layoutName)
             '(-4 . "<OR")
             '(0 . "SOLID")
             '(2 . "SOLID")
             '(-4 . "OR>")
           )
       )
      )
    )
    (setq slist    (list '(-4 . "<OR")
              '(0 . "SOLID")
              '(2 . "SOLID")
              '(-4 . "OR>")
        )
    )
  )
  (setq ssets (ssget "X" slist))
  (if ssets
    (progn
      (setq pt (list 0.0 0.0))
      (entmake ;;write block header
           (list '(0 . "BLOCK")
             '(2 . "*anon")
             '(70 . 1)
             (cons '10 pt)
           )
      )
      (setq a 0)
      (repeat (sslength ssets)
    (setq ent2 (entmake (entget (setq ent (ssname ssets a)))))
    (if (null ent2)
      (princ (entget (setq ent (ssname ssets a))))
    )
    (if (assoc 66 (entget ent))
      (progn
        ;;add sub-entities until seqend is found
        (setq subent (entnext ent))
        (while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
          (entmake (entget subent))
          (setq subent (entnext subent))
        )
        (setq ent3 (entmake (entget subent)))
        (if    (null ent3)
          (princ (entget subent))
        )
      )
    )
    (entdel ent)
    (setq a (1+ a))
    (c:spin "Making Block of solids..")
      )
      (setq names (entmake '((0 . "endblk"))))
      (princ "\n  Inserting...\n")
      (if Mins
    (entmake
      (list    '(0 . "INSERT")
        (CONS '100 "AcDbMInsertBlock")
        (CONS '70 2)
        (CONS '71 2)
        (cons '2 names)
        (cons '10 pt)
      )
    )
    (entmake
      (list    '(0 . "INSERT")
        (cons '2 names)
        (cons '10 pt)
      )
    )
      )
      (setq so (entlast))
      (setq ba "back")
      (command "_.draworder" so "" (strcat "_" ba))
      (setq ssets nil)
    )
  )
  (princ)
)

(defun anonBlock (layoutName Mins)
  (if layoutName
    (cond
      ((= layoutName "14MS")
       (setq alist (list '(-4 . "<NOT")
             '(-4 . "<OR")
             '(67 . 1)
             '(0 . "ACAD_PROXY_ENTITY")
             '(0 . "AEC_*")
             '(0 . "AECS_*")
             '(0 . "RTEXT")
             '(0 . "WIPEOUT")
             ;;'(8 . "LAYCFG")
             '
              (0 . "SOLID")
             '(2 . "SOLID")
             (cons 8 (getlayers))
             '(62 . 8)
             '(62 . 9)
             '(62 . 251)
             '(62 . 252)
             '(62 . 253)
             '(62 . 254)
             '(62 . 255)
             '(-4 . "OR>")
             '(-4 . "NOT>")
           )
       )
      )
      ((= layoutName "14PS")
       (setq alist (list '(67 . 1)
             '(-4 . "<NOT")
             '(-4 . "<OR")
             '(0 . "VIEWPORT")
             '(0 . "ACAD_PROXY_ENTITY")
             '(0 . "AEC_*")
             '(0 . "AECS_*")
             '(0 . "RTEXT")
             '(0 . "WIPEOUT")
             ;;'(8 . "LAYCFG")
             '
              (0 . "SOLID")
             '(2 . "SOLID")
             (cons 8 (getlayers))
             '(62 . 8)
             '(62 . 9)
             '(62 . 251)
             '(62 . 252)
             '(62 . 253)
             '(62 . 254)
             '(62 . 255)
             '(-4 . "OR>")
             '(-4 . "NOT>")
           )
       )
      )
      (T
       (setq alist (list (cons 410 layoutName)
             '(-4 . "<NOT")
             '(-4 . "<OR")
             ;;'(8 . "LAYCFG")
             '
              (0 . "VIEWPORT")
             '(0 . "ACAD_PROXY_ENTITY")
             '(0 . "AECC_*")
             '(0 . "AEC_*")
             '(0 . "AECS_*")
             '(0 . "RTEXT")
             '(0 . "WIPEOUT")
             '(0 . "SOLID")
             '(2 . "SOLID")
             (cons 8 (getlayers))
             '(62 . 8)
             '(62 . 9)
             '(62 . 251)
             '(62 . 252)
             '(62 . 253)
             '(62 . 254)
             '(62 . 255)
             '(-4 . "OR>")
             '(-4 . "NOT>")
           )
       )
      )
    )
    (setq alist    (list '(-4 . "<NOT")
              '(-4 . "<OR")
              ;;'(8 . "LAYCFG")
              '
               (0 . "VIEWPORT")
              '(0 . "ACAD_PROXY_ENTITY")
              '(0 . "AECC_*")
              '(0 . "AEC_*")
              '(0 . "AECS_*")
              '(0 . "RTEXT")
              '(0 . "WIPEOUT")
              '(0 . "SOLID")
              '(2 . "SOLID")
              (cons 8 (getlayers))
              '(62 . 8)
              '(62 . 9)
              '(62 . 251)
              '(62 . 252)
              '(62 . 253)
              '(62 . 254)
              '(62 . 255)
              '(-4 . "OR>")
              '(-4 . "NOT>")
        )
    )
  )
  (setq sset (ssget "X" alist))
  (setq viewsset (ssget "X" '((0 . "VIEWPORT"))))
  (if viewsset
    (progn
      (setq n 0)
      (repeat (sslength viewsset)
    (if (setq clipent (assoc 340 (entget (ssname viewsset n))))
      (ssdel (cdr clipent) sset)
    )
    (setq n (1+ n))
      )
    )
  )
  (if sset
    (progn
      (setq pt (list 0.0 0.0))
      (entmake ;;write block header
           (list '(0 . "BLOCK")
             '(2 . "*anon")
             '(70 . 1)
             (cons '10 pt)
           )
      )
      (setq a 0)
      (repeat (sslength sset)
    (setq ent2 (entmake (entget (setq ent (ssname sset a)))))
    (if (null ent2)
      (princ (entget (setq ent (ssname sset a))))
    )
    (if (assoc 66 (entget ent))
      (progn
        ;;add sub-entities until seqend is found
        (setq subent (entnext ent))
        (while (/= (cdr (assoc 0 (entget subent))) "SEQEND")
          (entmake (entget subent))
          (setq subent (entnext subent))
        )
        (setq ent3 (entmake (entget subent)))
        (if    (null ent3)
          (princ (entget subent))
        )
      )
    )
    (entdel ent)
    (setq a (1+ a))
    (c:spin "Making Block..")
      )
      (setq name (entmake '((0 . "endblk"))))
      (princ "\n  Inserting Block..\n")
      (if Mins
    ;;Minsert block reference at insertion point
    (entmake
      (list    '(0 . "INSERT")
        (CONS '100 "AcDbMInsertBlock")
        (CONS '70 2)
        (CONS '71 2)
        (cons '2 name)
        (cons '10 pt)
      )
    )
    (entmake
      (list    '(0 . "INSERT")
        (cons '2 name)
        (cons '10 pt)
      )
    )
      )
      (setq sset nil)
      (setq viewsset nil)
    )
    (if    layoutName
      (princ (strcat "\nNo entities to lock in " layoutName))
    )
  )
  (princ)
)

(defun Finish (vers)
  (setvar "clayer" cla)
  (setvar "tilemode" space)
  (if (= vers 2)
    (command "-layer" "state" "restore" "lockup" "" "")
  )
  (command "-layer" "lock" "*" "")
  (setvar "proxyshow" 1)
  (command "regen")
  (cond
    ((= cont "Yes")
     (alert
       "\nPaper space only has been locked.
                                \nTo lock model space, run Lockup
                                \nagain and do NOT skip to paper space."
     )
    )
    ((= answer2 "Model")
     (alert "\nAll selected entities have been locked.")
    )
    ((= answer2 nil)
     (alert "\nAll selected entities have been locked.")
    )
  )
  (setq    cont nil
    answer2    nil
  )
  (princ "\n加密完成. ")
  (princ)
)
(defun goLock14PS ()
  (setvar "tilemode" 0)
  (proxy)
  (anonBlock "14PS" nil)        ; make anon insert - on paper space
  (backblk "14PS" nil)            ; make anon insert - on paper space
  (solidBlk "14PS" nil)            ; make anon insert - on paper space
  (anonBlock "14PS" T)            ; make anon minsert - on paper space
  (command "zoom" "extents")
  (prompt "\n  Paper Space has been locked.")
  (Finish 0)
)

(defun goLockPS    (vers)
  (if (= vers 0)
    (goLock14PS)
    (progn
      (princ "\nType in Layout Name to make current: ")
      (command "layout" "set" pause)    ;type in whatever layout to set current
      (while (> (getvar "cmdactive") 0) (command pause))
      (proxy)
      (anonBlock (getvar "CTAB") nil)    ; make anon insert in named layout
      (backblk (getvar "CTAB") nil)    ; make anon insert in named layout
      (solidblk (getvar "CTAB") nil)    ; make anon insert in named layout
      (anonBlock (getvar "CTAB") T)    ; make anon minsert in named layout
      (command "zoom" "extents")
      (initget "Yes No")
      (prompt
    (strcat "\n  Layout " (getvar "ctab") " has been locked.")
      )
      (setq answer
         (getkword "\nAre there more layouts to lock? Y/<N>: ")
      )
      (cond
    ((or (null answer) (= answer "No"))
     (Finish vers)
    )
    ((= answer "Yes")
     (goLockPS vers)
    )
    (T nil)
      )
    )
  )
)

(defun goLock (vers)
  (setvar "tilemode" 1)
  (if (= vers 2)
    (command "-layer" "state" "save" "lockup" "" "" "")
  )
  (command "-layer" "thaw" "*" "on" "*" "unlock" "*" "")
  (command "zoom" "extents")
  (proxy)
  (if (/= vers 0)
    (progn
      (anonBlock "Model" nil)        ; make anon insert in model space
      (backblk "Model" nil)        ; make anon insert in model space
      (solidblk "Model" nil)        ; make anon insert in model space
      (anonBlock "Model" T)        ; make anon minsert in model space
    )
    (progn
      (anonBlock "14MS" nil)
      (backblk "14MS" nil)
      (solidblk "14MS" nil)
      (anonBlock "14MS" T)
    )
  )
  (prompt "\n  Model Space has been locked.")
  (initget "Yes No")
  (setq    answer
     (getkword "\nDo you want to lock Paper Space? Y/<N>: ")
  )
  (cond
    ((or (null answer) (= answer "No")) (Finish vers))
    ((= answer "Yes") (goLockPS vers))
    (T nil)
  )
)

(defun states ()
  (if (= vers 2)
    (command "-layer" "state" "save" "lockup" "" "" "")
  )
  (command "-layer" "thaw" "*" "on" "*" "unlock" "*" "")
  (command "graphscr")
  (command "zoom" "extents")
  (goLockps vers)
)

(defun continue    ()
  (initget "Yes No")
  (setq    cont (getkword
           "\nModel Space will not be locked! Continue? Y/<N>: "
         )
  )
  (cond    ((= cont "Yes") (states))
    ((= cont "No") (skip))
    ((= cont nil) (skip))
  )
)

(defun skip ()
  (initget "Skip Model")
  (setq    answer2
     (getkword
       "\nStart in Model Space or Skip to Paper Space? Skip/<Model>:"
     )
  )
  (cond    ((= answer2 "Skip") (continue))
    ((= answer2 "Model") (goLock vers))
    ((= answer2 nil) (goLock vers))
  )
)

(defun 14or2k (/ answer)
  (initget "14 2000 2000i")
  (setq    answer
     (getkword
       "\nWhat version of AutoCAD are you in? 14/2000<2000i>: "
     )
  )
  (cond
    ((= answer "14") (setq vers 0))
    ((= answer "2000") (setq vers 1))
    ((= answer "2000i") (setq vers 2))
    ((= answer nil) (setq vers 2))
  )
  (skip)
)

(defun goexp ()
  (progn
    (repeat (sslength sset)
      (command "_explode" (ssname sset CNT))
      (setq CNT (1+ CNT))
      (c:spin "Exploding..")
    )
    (alert (strcat "\n    " (itoa CNT) " Entities Exploded."))
  )
  (setq sset nil)
  (princ)
)

(defun xpproxy (/ xpl)
  (alert
    "\n     Proxy Entities have been found.
    If they are not exploded, they will
  be omitted from the lockup process."
  )
  (initget "Yes No")
  (setq xpl (getkword "\nExplode Proxy Entities? Y/<N>: "))
  (if (or (= xpl "No") (= xpl nil))
    (princ)
  )
  (if (= xpl "Yes")
    (goexp)
  )
  (princ)
)

(defun goerase ()
  (progn
    (repeat (sslength wsset)
      (entdel (ssname wsset WCNT))
      (setq WCNT (1+ WCNT))
      (c:spin "Erasing..")
    )
    (alert (strcat "\n    " (itoa WCNT) " Wipeouts Erased."))
  )
  (setq wsset nil)
  (princ)
)

(defun goaskerase (/ del)
  (alert
    "\n     Wipeouts have been found."
  )
  (initget "Yes No")
  (setq del (getkword "\nErase Wipeouts? Y/<N>: "))
  (if (or (= del "No") (= del nil))
    (princ)
  )
  (if (= del "Yes")
    (goerase)
  )
  (princ)
)

(defun gowipeout (/ where wlist)
  (setq where (getvar "tilemode"))
  (setq cs 67)
  (if (= where 0)
    (setq sp 1)
  )
  (if (= where 1)
    (setq sp 0)
  )
  (setq    wlist (list (cons cs sp)
            '(0 . "wipeout")
          )
  )
  (setq WCNT 0)
  (setq wsset (ssget "x" wlist))
  (if (= wsset nil)
    (princ)
  )
  (if (not (= wsset nil))
    (goaskerase)
  )
  (princ)
)

(defun proxy (/ where plist)
  (setq where (getvar "tilemode"))
  (if (= where 0)
    (setq plist    '((-4 . "<NOT")
          (67 . 0)
          (-4 . "NOT>")
          (-4 . "<OR")
          (0 . "ACAD_PROXY_ENTITY")
          (0 . "AECC_*")
          (0 . "AEC_*")
          (0 . "AECS_*")
          (0 . "RTEXT")
          (-4 . "OR>")
         )
    )
  )
  (if (= where 1)
    (setq plist    '((-4 . "<NOT")
          (67 . 1)
          (-4 . "NOT>")
          (-4 . "<OR")
          (0 . "ACAD_PROXY_ENTITY")
          (0 . "AECC_*")
          (0 . "AEC_*")
          (0 . "AECS_*")
          (0 . "RTEXT")
          (-4 . "OR>")
         )
    )
  )
  (setq CNT 0)
  (setq sset (ssget "x" plist))
  (if (= sset nil)
    (princ)
  )
  (if (not (= sset nil))
    (xpproxy)
  )
  (gowipeout)
  (princ)
)

(defun c:undolock ()
  ;;Undo and Reset variables
  (setvar "cmdecho" 0)
  (princ "\nPlease wait while Lockup is undone.")
  (command "undo" "end")
  (command "undo" "back")
  (setvar "cmdecho" 1)
  (setvar "filedia" 1)
  (setvar "cmddia" 1)
  (setvar "clayer" cla)
  (princ "\nLockup has been undone.")
  (princ)
)

(defun c:look (/ alist CNT sset)
  (setq    alist '((-4 . "<OR")
        (0 . "ACAD_PROXY_ENTITY")
        (0 . "AECC_*")
        (0 . "AEC_*")
        (0 . "AECS_*")
        (0 . "RTEXT")
        (0 . "WIPEOUT")
        (-4 . "OR>")
           )
  )
  (setq CNT 0)
  (if alist
    (progn
      (setq sset (ssget "X" alist))
      (if sset
    (repeat    (sslength sset)
      (setq CNT (1+ CNT))
    )
      )
      (if (= CNT 1)
    (alert (strcat "\n        " (itoa CNT) " Entity found."))
      )
      (if (> CNT 1)
    (alert (strcat "\n       " (itoa CNT) " Entities found."))
      )
    )
  )
  (if (= sset nil)
    (alert "\nNo Entities were found.")
  )
  (princ)
)

(defun c:spin (wh)
  (prompt (strcat "\r  "
          wh
          (cond    ((= sp "|") (setq sp "/"))
            ((= sp "/") (setq sp "-"))
            ((= sp "-") (setq sp "\\"))
            (T (setq sp "|"))
          )
      )
  )
  (princ)
)

(defun C:Lockup    (/ start answer)
  (setq    fdia    (getvar "filedia")
    cdia    (getvar "cmddia")
    cmd    (getvar "cmdecho")
    cla    (getvar "clayer")
    space    (getvar "tilemode")
    olderr    *error*
    *error*    lockerror
    cont    nil
    answer2    nil
  )
  (setvar "cmdecho" 0)
  (command "UNDO" "Begin")
  (setvar "filedia" 0)
  (setvar "cmddia" 0)
  (command "undo" "mark")
  (command "-layer" "make" "LOCKUP" "")
  (command "color" "bylayer")
  (setvar "proxyshow" 0)
  (command "regen")
  (initget "Yes No")
  (setq    answer
     (getkword
       "\n请确认作好了图纸备份！继续加密? Y/<N>: "
     )
  )
  (cond
    ((or (= answer "No") (null answer))
     (Alert "LOCKUP aborted!")
    )
    ((= answer "Yes") (14or2k))
  )
  (command "UNDO" "End")
  (setq *error* olderr)
  (setvar "filedia" fdia)
  (setvar "cmddia" cdia)
  (setvar "cmdecho" cmd)
  (princ)
)
(princ)
;****************************************************多块同时缩放
(defun c:bs ()
  (command "_.undo" "_begin")
  (setq    old_err    *error*
    *error*    Sb_err
  )
  (setq blkname (getstring "\n请输入需缩放的块名称:"))
  (initget 7)
  (setq blkfactor (getreal "\n请输入缩放倍数:"))
  (setq blksset (ssget (list (cons 0 "INSERT") (cons 2 blkname))))
  (setq blksscnt (sslength blksset))
  (setq donecount 0)
  (while (> blksscnt 0)
    (setq temp (ssname blksset (setq blksscnt (1- blksscnt))))
    (setq templist (entget temp))
    (setq blkbasept (cdr (assoc 10 templist)))
    (command "scale" temp "" blkbasept blkfactor ^c)
    (setq donecount (1+ donecount))
  )
  (princ (strcat "\n完成缩放 "
         (itoa donecount)
         " 个名称为"
         "\""
         blkname
         "\""
         "的块."
     )
  )
  (command "_.undo" "_end")
)

(defun Bs_err (s)
  (princ "\n命令中止!")
  (setq *error* old_err)
  (princ)
)

(princ)
;****************************************************块统计
(defun c:btj ()
 (setq st t)
 (while st
 (while  (not (setq st (entsel "\n选择需要统计的块:"))))
            (if  (= (cdr (assoc '0 (entget (car st)))) "INSERT")
                 (progn
                 (setq blockname (cdr (assoc '2 (entget (car st)))))
                 (setq st nil)
                 )
                 (princ "\n未选择到块!")
            )              
 )

 (princ (strcat "\n选择块" blockname "<全选>:"))
 (setq ss (ssget))
 (if (= ss nil) (setq ss (ssget "x")))
 (setq n 0 m 0)
 (while (and ss (< n (sslength ss)))
           (setq ssn (ssname ss n))
           (if (= (cdr (assoc '0 (entget ssn))) "INSERT")
               (progn
              (setq blockname1 (cdr (assoc '2 (entget ssn))))           
              (if (= blockname blockname1)
                  (setq m (+ m 1))
              )
              )
            )
            (setq n (+ n 1))
 )
 (alert  (strcat "块" blockname ":" (rtos m 2 0) "个"))
 (setq pt (getpoint "\n给定输出的点位<不输出>:"))
 (if pt
     (command "text" pt (getvar "textsize") "0"   (strcat "块" blockname "  " (rtos m 2 0) "个"))
 )
 )
;****************************************************合并单行文本
(defun update (mode txt el1 / ent el1)
  (setq ent (subst (cons mode txt) (assoc mode el1) el1))
  (entmod ent)
)
(defun C:ttt(/ ent1 el1 e1 txt1 ent2 el2 e2 txt2 txt tst ent)
(setvar "CMDECHO" 0)
(setq tst T)
(setq ent1 (car (entsel "\n请选择基准文本: ")))
(if (/= ent1 nil)
  (progn
    (setq el1 (entget ent1))
    (setq e1 (cdr (assoc -1 el1)))
    (if (= "TEXT" (cdr (assoc 0 el1)))
      (progn
        (while tst
          (setq txt1 (cdr (assoc 1 (entget e1))))
          (setq ent2 (car (entsel "\n请选择加入文本: ")))
          (if (/= ent2 nil)
            (progn
              (setq el2 (entget ent2))
              (setq e2 (cdr (assoc -1 el2)))
              (if (= "TEXT" (cdr (assoc 0 el2)))
                (progn
                  (setq txt2 (cdr (assoc 1 el2)))
                    (command "erase" e2 "")
                    (setq txt (strcat txt1 txt2))
                    (update 1 txt el1)
                )
                (princ "\n你选择的不是单行文本 !") 
              )
            )
            (setq tst nil)
          )
        )
      )
      (princ "\n你选择的基准文本不是单行文本!") 
    )
  )
)
(redraw)
(princ)
)
;****************************************************合并文字
(defun c:tt()
  (command "osnap" "off")
  (setq kg1 (getint"\n合并字符间空格数0~10<0>:"))
  (if (= kg1 nil)(setq kg11 ""))
  (if (= kg1 0)(setq kg11 ""))
  (if (= kg1 2)(setq kg11 "  "))
  (if (= kg1 3)(setq kg11 "   "))
  (if (= kg1 4)(setq kg11 "    "))
  (if (= kg1 5)(setq kg11 "     "))
  (if (= kg1 6)(setq kg11 "      "))
  (if (= kg1 7)(setq kg11 "       "))
  (if (= kg1 8)(setq kg11 "        "))
  (if (= kg1 9)(setq kg11 "         "))   
  (if (= kg1 10)(setq kg11 "          "))
  (setq zzz "")
  (princ "\n选择字符串:")
  (setq s (ssget))
  (setq n (sslength s))
  (setq k 0 )(setq cgm 0)
  (setq fxx nil)
  (setq fyy nil)
  (setq fzz nil)
  (setq pxx1 nil)
  (setq pyy1 nil)

  (while (< k n)
        (setq name (ssname s k))
        (setq a (entget name))
        (if (= k 0) (progn
            (setq b (assoc '0 a))
            (setq b (cdr b))
            (setq h0 (assoc '40 a))
            (setq h0 (cdr h0))
            (setq ag1 (assoc '50 a))
            (setq ag1 (cdr ag1))
        (setq ag1 (* ag1 180) ag1 (/ ag1 pi))
            ))
        (setq nam1 (assoc '-1 a))
        (setq nam1 (cdr nam1))
        (setq xxx (assoc '10 a))
        (setq xy (cdr xxx))
        (setq xx (car xy) yy (cdr xy) yy (car yy))
        (setq tx1 (assoc '1 a))
        (setq tx1 (cdr tx1))
        (setq k (+ k 1))

        (setq lxx (list xx tx1))
        (setq lyy (list yy tx1))
        (setq lxx (list lxx))
        (setq lyy (list lyy))
        (setq fxx (append fxx lxx))
        (setq fyy (append fyy lyy))
        (setq pxx (list xx) pyy (list yy))
        (setq pxx1 (append pxx1 pxx) pyy1 (append pyy1 pyy))
        (entdel nam1)
    )
    (setq pxx1 (vl-sort pxx1 '<))
    (setq pyy1 (vl-sort pyy1 '<))
    (setq px (car pxx1) py (car pyy1))
    (setq p1 (list px py))
    (if (= ag1 0)(progn
        (setq fzz (vl-sort fxx
                  (function (lambda (e1 e2)
                            (< (car e1) (car e2))))))
    ))
    (if (> ag1 0)(progn
        (setq fzz (vl-sort fyy
                  (function (lambda (e1 e2)
                            (< (car e1) (car e2))))))
    ))



           
        (setq nn 0)
        (while (< nn k)
         (setq zz1 (car fzz))
         (setq zz1 (cdr zz1) zz1 (car zz1))
         (setq zzz (strcat zzz kg11 zz1))
         (setq fzz (cdr fzz))
         (setq nn (+ nn 1))
        )
  (command "text" p1 h0 ag1 zzz)
  (command "osnap" "int,mid,nea,cen,per,tan")
)
;****************************************************字按线对齐
(setq *Nblock* 0)
(defun GetNestEntity(ELst / ent1 ss1 pt lst lst1 Obj lst2 )
  (setq ent1 (car ELst)
    pt   (cadr ELst)
    lst1 (entget ent1)
        Obj  (cdr (assoc 0 lst1))
    ss1  nil
    ;n    0
  );;;end setq
  (if (or (wcmatch Obj "INSERT") (wcmatch Obj "LWPOLYLINE") (wcmatch Obj "POLYLINE"))
    (progn
      (command "_.explode" ent1)
      (setq *Nblock* (1+ *Nblock*))
      (if (setq ss1 (ssget pt))
        (setq lst2 (list (ssname ss1 0) pt)
              lst (GetNestEntity lst2))
    (progn
      (command "_.undo" *Nblock*)
      (setq *Nblock* 0)
      (exit)
    ) 
      )    
      (list (car lst) (1+ (cadr lst)))
    )
    (list ent1 0)
  
  );;;end if
 
 )
;;;////////////////////////
(defun C:TL(/ lst n ent txt objtype errhandler olderr elst lst1)
  (setq *Nblock* 0)
;;;//////////////////////
(defun errhandler(s)
  (if (/= s "Function cancelled")
       (if (= s "quit / exit abort")
           (princ)
           (princ (strcat "\nError: " s))
        )
   );;;end if
  ;(if (> n 0) (command "_.undo" n))
  (if olderr (setq *error* olderr))
  ;(princ ent)(princ)
  (if ent (command "_.erase" ent ""))
  (command "_.undo" "end")
  ;(if (> n 0) (command "_.undo" n))
);;;end defun
;;;///////////////////////////
  (command "_.undo" "begin")
  (if *error*
    (setq olderr *error* *error* errhandler)
    (setq *error* errhandler))
  (setvar "cmdecho" 0)
  (setvar "errno" 7)
  (while (= (getvar "errno") 7)
    (setq lst (entsel "\nSelect Object [Line Or Arc]:"))
    (if lst
     (progn
       (setq lst1 (GetNestEntity lst)
             n    (last lst1)
         ent  (car lst1)
         elst (entget ent)
         objtype (cdr (assoc 0 elst))
         *Nblock* 0)
       (if (> n 0) (command "_.undo" n))
       (entmake elst)
       (setq ent (entlast))
       (if (or (wcmatch objtype "LINE")
           (wcmatch objtype "ARC"))
           ;(wcmatch objtype "CIRCLE"))
    (progn
         (redraw ent 3)
         (setvar "errno" 7)
         (while (= (getvar "errno") 7)
          (setq txt (entsel "\nSelect text:"))
      (if txt
       (progn
        (setq txt (car txt))
        (if (wcmatch (cdr (assoc 0 (entget txt))) "TEXT")
         (progn
              (cond
           ((wcmatch (cdr (assoc 0 (entget ent))) "LINE") (TextAlignToLine ent txt))
           ((wcmatch (cdr (assoc 0 (entget ent))) "ARC") (TextAlignToArc ent txt))
           ((wcmatch (cdr (assoc 0 (entget ent))) "CIRCLE") (alert "You pick a Circle"))
              );;;end cond
          ;(setvar "errno" 0)
        );;;end progn 
       );;;end if
      );;;progn
          );;;end if
         );;;end while
         (setvar "errno" 0)
     (entdel ent)
       )
       (progn
     (command "_.erase" ent "")
         (setvar "errno" 7)
       );;;end progn
      );;;end if
     );;;end progn
    );;;end if
  );;;end while
  (command "_.undo" "end")
  (princ)
)
;;;//////////////////
(defun TextAlignToLine(Line Text / LineTable PointStart PointEnd LineAngle TextTable)
  (setq LineTable  (entget Line)
    PointStart (cdr (assoc '10 LineTable))
    PointEnd   (cdr (assoc '11 LineTable))
        LineAngle  (angle PointStart PointEnd)
  )
   (if (or (> (* pi 1.5) LineAngle (* pi 0.5)) (= LineAngle (* pi 1.5)))
    (setq LineAngle (- LineAngle pi))
   );;;end if
  (setq TextTable (entget Text)
    TextTable (subst (cons '50 LineAngle) (assoc '50 TextTable) TextTable))
  (entmod TextTable)
  (setvar "errno" 7)
)
;;;///////////////////////
(defun TextAlignToArc(Arc Text / ArcTable Centerpoint TextTable TextBpt ang)
  (setq ArcTable    (entget Arc)
    Centerpoint (cdr (assoc 10 ArcTable))
    TextTable   (entget Text)
    TextBpt     (cdr (assoc 10 TextTable))
    ang         (+ (angle Centerpoint TextBpt) (/ pi 2))
  )
  ;(if (> ang (* 2 pi)) (setq ang (- ang (* 2 pi))))
  (if (or (> (* pi 1.5) ang (* pi 0.5)) (= ang (* pi 1.5)))
    (setq ang (- ang pi))
   );;;end if
  ;(command "_.line" Centerpoint TextBpt "")(princ)
  (setq TextTable  (subst (cons '50 ang) (assoc '50 TextTable) TextTable))
  (entmod TextTable)
  ;(alert "You pick an Arc")
  (setvar "errno" 7)
)
;****************************************************炸开文字
(Defun C:XT (/ lvl lul lvp lvs lss ViewPL)
(SetQ lvs (GetVar "viewsize")
lss (GetVar "screensize")
)
(SetVar "cmdecho" 0)
(Defun ViewPL ( / vi vw vh vc)
(setq vi (* lvs (/ (Car lss) (Cadr lss)))
vc (GetVar "viewctr")
vw (list (- (car vc) (* 0.5 vi))
(- (cadr vc) (* 0.5 lvs))
)
vh (list (+ (car vc) (* 0.5 vi))
(+ (cadr vc) (* 0.5 lvs))
)
)
(List vw vh)
)
(PrinC "\n要分解的文字行: ")
(SetQ ltl (SSGet)
lvl (ViewPL)
lul (List (Caar lvl) (Cadadr lvl))
lvp (GetVar "viewctr")
)
(Command "mirror" ltl "" lvp "@0,1" "y"
"wmfout" "textb" ltl ""
"erase" ltl ""
"wmfin" "textb" lul "2" "" ""
"mirror" (EntLast) "" lvp "@0,1" "y"
"explode" (EntLast)
"erase" (ssget "p") "R" "W"
(polar (car lvl) (* 0.25 Pi)
(Max (Abs (/ lvs (Cadr lss)))
(Abs (/ (* lvs
(/ (Car lss) (Cadr lss))
)
(Car lss)
)
)
)
)
(cadr lvl)
""
)
(SetVar "cmdecho" 1)(PrinC)
)
;****************************************************改大小写
(defun c:dx ( / oldblp oldech olderr p dx L )
  (setq oldblp (getvar "blipmode")
        oldech (getvar "cmdecho")
        olderr *error*
  )
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (defun *error* (msg)
    (princ "\n")
    (princ msg)
    (setvar "blipmode" oldblp)
    (setvar "cmdecho" oldech)
    (setq *error* olderr)
    (princ)
  )
  (prompt "\n请选择要改变的字符串.")
  (setq P (ssget))
  (initget 1 "D X")
  (setq dx (getkword"\n改成: [大写(D)/小写(X)]"))
  (setq L 0 m 0 n (sslength p))
  (while (< L n)
    (setq q (ssname p l))
    (if (= "TEXT" (cdr (assoc 0 (setq e (entget (ssname p l))))))
      (progn
        (if (= "X" dx)
          (progn
            (setq w1 (strcase (cdr (setq b (assoc 1 e))) T))
            (setq e (subst (cons 1 w1) b e))
            (entmod e)
            (setq m (+ 1 m))
          )
        )
        (if (= "D" dx)
          (progn
            (setq w1 (strcase (cdr (setq b (assoc 1 e)))))
            (setq e (subst (cons 1 w1) b e))
            (entmod e)
            (setq m (+ 1 m))
          )
        )
      )
    )
    (setq l (+ 1 l))
  )
  (if (= 0 m)
    (progn
      (princ "\n\t  没有任何被选中")
      (princ)
    )
  )
  (setvar "blipmode" oldblp)
  (setvar "cmdecho" oldech)
  (setq *error* olderr)
  (princ)
)
;****************************************************将所选对象的层变为当前层
(DEFUN C:LL( / e n)
(setq e (car (entsel "请选择对象，该对象所在层将变为当前层:")))
(if e (progn
(setq e (entget e))
(setq n (cdr (assoc 8 e)))
(command"layer" "set" n "")
))
)
;****************************************************只显示被选对象所在层
(DEFUN C:lli (/ ES EN EL A)
 (princ "请选择对象，未被选中的对象所在的层将被关闭")
 (setq ES (ssget) A 0 EN "" EL nil FL nil)
 (while (/= EN nil)
 (setq EN (ssname ES A) EL (cons EN EL) A (1+ A)))
 (setq EL (cdr EL) FL (cdr (assoc ' 8 (entget (car EL)))) EL (cdr EL))
 (repeat (- A 2)
 (setq EN (cdr (assoc ' 8 (entget (car EL))))
  FL (strcat EN "," FL) EL (cdr EL)) )
 (command "LAYER" "off" "*" "y" "on" (eval FL) "")
(princ))
;****************************************************快速改对象的层
(DEFUN C:LK()
(princ "请选择要改变层的对象\n")
(setq ss (ssget))
(if (and ss (> (sslength ss) 0))
(progn
(setq ent (entsel "\n请选择目标层上的对象:"))
(if ent (setq la (cdr(assoc 8 (entget (car ent)))))
(setq la (getvar "clayer"))
)
(command ".chprop" ss "" "layer" la "")
)
)
(princ)
)
;****************************************************解锁图层
(defun C:LJ (/ ES EN EL A)
       (princ "请选择要解锁的图层上的对象")
       (setq ES (ssget) A 0 EN "" EL nil FL nil)
       (while (/= EN nil)
       (setq EN (ssname ES A) EL (cons EN EL) A (1+ A)))
       (setq EL (cdr EL) FL (cdr (assoc ' 8 (entget (car EL)))) EL (cdr EL))
       (repeat (- A 2)
       (setq EN (cdr (assoc ' 8 (entget (car EL))))
       FL (strcat EN "," FL) EL (cdr EL)) )
       (command "LAYER" "U" (eval FL) "")
(princ))
;****************************************************关闭所选物体所在的层
(DEFUN  C:Q1 ()
  (setvar "cmdecho" 0)
  (prompt"\n请选择要关闭的图层上的对象")
  (setq ss (ssget))
  (if (and ss (sslength ss) 0)
    (progn
     (setq ct 0 len (sslength ss) cl (getvar "clayer"))
     (command ".layer")
     (while (< ct len)
         (setq la (cdr (assoc 8 (entget (ssname ss ct)))))
         (if (/= cl la)(command "off" la)
                       (progn (prompt "\n你选择的层:")
                              (prompt la)
                              (prompt " 是当前层，不能关闭")
                       )  ;end of progn
         )                ;end of if
         (if (= old nil)(setq OLD la)(setq OLD (strcat OLD "," la)))
         (setq ct (1+ ct))
       )                  ;end of while
       (command"")
     )                  ;end of progn
 )                      ;end of if
 (princ)
 (setvar "cmdecho" 0) (prin1)
)
;****************************************************冻结所选物体所在的层
(defun C:Q2 (/ ES EN EL A)
 (princ "请选择要冻结的图层上的对象.")
 (setq ES (ssget) A 0 EN "" EL nil FL nil)
 (while (/= EN nil)
 (setq EN (ssname ES A) EL (cons EN EL) A (1+ A)))
 (setq EL (cdr EL) FL (cdr (assoc ' 8 (entget (car EL)))) EL (cdr EL))
 (repeat (- A 2)
 (setq EN (cdr (assoc ' 8 (entget (car EL))))
  FL (strcat EN "," FL) EL (cdr EL)) )
 (command "LAYER" "F" (eval FL) "")
(princ))
;****************************************************锁定所选物体所在的层
(defun C:Q3 (/ ES EN EL A)
 (princ "请选择要加锁的图层上的对象.")
 (setq ES (ssget) A 0 EN "" EL nil FL nil)
 (while (/= EN nil)
 (setq EN (ssname ES A) EL (cons EN EL) A (1+ A)))
 (setq EL (cdr EL) FL (cdr (assoc ' 8 (entget (car EL)))) EL (cdr EL))
 (repeat (- A 2)
 (setq EN (cdr (assoc ' 8 (entget (car EL))))
  FL (strcat EN "," FL) EL (cdr EL)) )
 (command "LAYER" "LO" (eval FL) "")
(princ))
;****************************************************显示全部层
(DEFUN C:W1 ()
       (command "layer" "on" "*" "")
(princ))
;****************************************************解冻全部层
(DEFUN C:W2 ()
        (COMMAND "LAYER" "THAW" "*" "")
    (PRINC)
)
;****************************************************解锁全部层
(DEFUN C:W3 ()
        (COMMAND "LAYER" "U" "*" "")
    (PRINC)
)
;****************************************************显示+解锁+解冻全部层
(DEFUN C:W123 ()
        (command "layer" "on" "*" "")
        (COMMAND "LAYER" "THAW" "*" "")
        (COMMAND "LAYER" "U" "*" "")
    (PRINC)
)
(princ "***请输入 HH 查看命令列表***")

本文由中磊教育原创，转载请注明出处！

中磊教育是模具设计与制造专业人才技术交流平台，我们为你呈现模具设计教程、模具制造经验。

如果你是模具行业工作者，想分享技术、传承经验，请发邮件到 838676806@qq.com申请原创作者（有稿酬，具备图纸、模具经验、案例、教程者均可申请）。

中磊教育常年开设模具设计、产品编程\模具编程、产品造型、五金模具设计、压铸模具设计等课程，小班授课，随报随学，欢迎垂询：15217189306