[LISP程序]：共享个常用工具LISP

linshucai

(GRTEXT -2 "DRAFTING TOOLS ENABLED")
(DEFUN C:CT()
  (PROMPT "\nCHANGES COLOR AND LINETYPE  ALIAS CT")
  (SETQ A (SSGET)
        B (GETSTRING "\nSelect color: ")
        C (GETSTRING "\nSelect Cont, Dashed, Hidden, CenTeR, Phantom : "))
  (IF(= C "C")(SETQ C "CONTINUOUS"))
  (IF(= C "CTR")(SETQ C "CENTER"))
  (IF(= C "D")(SETQ C "DASHED"))
  (IF(= C "H")(SETQ C "HIDDEN"))
  (IF(= C "P")(SETQ C "PHANTOM"))
  (COMMAND "CHANGE" A "" "P" "C"  B  "LT" C "" )
  (PROMPT "\nCOLOR/LINETYPE (c) by Ken Jolly 1994")
  (PRINC)
  )
(DEFUN C:LE()
  (PROMPT "\nLeader (c) Ken Jolly 1994")
  (SETVAR "ORTHOMODE" 0)
  (COMMAND "DIM" "L" "NONE")
  (PRINC)
  )
(DEFUN C:DAN ()
  (PROMPT "\nDIMENSIONS ANGLES   ALIAS DAN")
  (COMMAND "DIM" "ANG")
  (PRINC)
  )
(DEFUN C:DR ()
  (PROMPT "\nDIMENSIONS RADII   ALIAS DR")
  (COMMAND "DIM" "RAD")
  (PRINC)
  )
(defun C:BK (/ CL A B C)
(PROMPT "\nMAKE BLOCKS & RE-INSERTS IT   ALIAS BK")
(setq cl(getvar "clayer"))
(setq a(getstring "\nEnter name of block : "))
(setq b(ssget))
(setq c(getpoint "\nSelect insertion point"))
(command "change" b "" "p" "la" "0" "" "")
(command "block" a c b "")
(command "layer" "s" cl "" "")
(command "insert" a c "" "" "")
(PROMPT "\n(c) by Ken Jolly 1994")
(princ)
)
(defun C:I (/ A B C)
(PROMPT "INSERTS EXPLODED BLOCK WITH NO TOGGLE DEFAULTS   ALIAS I")
(setq a(getstring "\nEnter block name :" ))
(setq b(getpoint "\nSelect insertion point:"))
(setq a(strcat "*" a))
(command "insert" a  b "" "" "" "")
(PROMPT "\n(c) by Ken Jolly 1994")
(princ)
)
(defun C:OM ()
(PROMPT "\nSETS OSMODE TO PICK NEAREST END, MID, INTERSECTION, OR NODE   ALIAS OM")
(setvar "osmode" 107)
(princ "\nOsnap is in multiple mode")
(PRINC)
)
(defun C:OX ()
(PROMPT "\nSETS OSMODE TO NONE   ALIAS OX")
(setvar "osmode" 0)
(princ "\nOsnap is set to none")
(PRINC)
)
(defun C:DV ()
(PROMPT "\nDIMENSION VERTICAL   ALIAS DV")
(setvar "osmode" 107)
(command "dim" "DIM" "ver")
(princ)
)
(defun C:DH ()
(PROMPT "\nDIMENSION HORIZONTAL   ALIAS DH")
(setvar "osmode" 107)
(command "dim" "dim" "hor" )
(princ)
)
(defun C:DC ()
(PROMPT "\nCONTINUES DIMENSION   ALIAS DC")
(setvar "osmode" 107)
(command "dim" "cont")
(princ)
)
(defun C:CC (/ A B)
  (PROMPT "\nCHANGES ENTITY TO NEW COLOR   ALIAS CC")
  (setq a(ssget))
  (setq b(getstring "\nNew color: "))
  (command "change" a "" "p" "c" b "" )
  (PROMPT "\n(c) by Ken Jolly 1994")
  (princ)
  )
(DEFUN C:CTP (/ A)
  (PROMPT "\nCHANGE SELECTED LINE TYPES TO PHANTOM")
  (SETQ A(SSGET))
  (COMMAND "CHANGE" A "" "P" "LT" "PHANTOM" "")
  (PROMPT "\n(c) by Ken Jolly 1994")
  (PRINC)
  )
(DEFUN C:CTD (/ A)
  (PROMPT "\nCHANGE SELECTED LINE TYPES TO DASHED")
  (SETQ A(SSGET))
  (COMMAND "CHANGE" A "" "P" "LT" "DASHED" "")
  (PROMPT "\n(c) by Ken Jolly 1994")
  (PRINC)
  )
(DEFUN C:CTH (/ A)
  (PROMPT "\nCHANGE SELECTED LINE TYPES TO HIDDEN")
  (SETQ A(SSGET))
  (COMMAND "CHANGE" A "" "P" "LT" "HIDDEN" "")
  (PROMPT "\n(c) by Ken Jolly 1994")
  (PRINC)
  )
(DEFUN C:CTC (/ A)
  (PROMPT "\nCHANGE SELECTED LINE TYPES TO CONTINUOUS")
  (SETQ A(SSGET))
  (COMMAND "CHANGE" A "" "P" "LT" "CONTINUOUS" "")
  (PROMPT "\n(c) by Ken Jolly 1994")
  (PRINC)
  )
(DEFUN C:CTR (/ A)
  (PROMPT "\nCHANGE SELECTED LINE TYPES TO CENTER")
  (SETQ A(SSGET))
  (COMMAND "CHANGE" A "" "P" "LT" "CENTER" "")
  (PROMPT "\n(c) by Ken Jolly 1994")
  (PRINC)
  )
(defun C:CA (/ A B)
  (PROMPT "\nCHANGES ENTITY TO NEW LAYER   ALAIAS CA")
  (setq a(ssget))
  (setq b(getstring "\nSelect new layer: "))
  (command "change" a "" "p" "la" b "" )
  (PROMPT "\n(c) by Ken Jolly 1994")
  (princ)
  )
(defun C:DA ()
   (PROMPT "\nALIGNED DIMENSIONS   ALIAS DA")
   (command "dim" "align")
   (princ)
   )
(Defun C:CM (/ A)
   (PROMPT "\nCOPY MULTIPLES   ALIAS CM")
   (setq a(SSGET))
   (command "copy" a "" "m" a)
   (PROMPT "\n(c) by Ken Jolly 1994")
   (princ)
   )
(DEFUN C:WB (/ CL A B C)
(PROMPT "\nCREATES WORLD BLOCKS AND RE-INSERTS   ALIAS WB")
(setq cl(getvar "clayer"))
(setq a(getstring "\nEnter name of block : "))
(setq b(ssget))
(setq c(getpoint "\nSelect insertion point"))
(command "change" b "" "p" "la" "0" "" "")
(command "block" a c b "")
(command "layer" "s" cl "" "")
(command "insert" a c "" "" "")
(COMMAND "WBLOCK" A  A )
(PROMPT "\n(c) by Ken Jolly 1994")
(princ)
)
(defun c:SL (/ LAYER)
  (setq LAYER
    (cdr
    (assoc 8
    (entget
    (car
    (entsel "Pick item for new layer "
    ))))))
  (command "LAYER" "SET" layer "")
)
(defun c:al ()
(PROMPT "\nDTEXT W/ ARC LEADER   ALIAS AL")
(setvar "cmdecho" 1)
(setq p1(getpoint"\nArrow location: "))
(setq p2(getpoint"\nText location: "))
(setq a1(angle p1 p2))
(setq a2(+ a1 (* pi 0.5)))
(setq a3(+ a1 (* pi 1.5)))
(setq d1(/ (distance p1 p2) 5))
(setq p3(polar (polar p1 a1 (* 4 d1)) a2 d1))
(setq p4(polar (polar p1 a1 d1) a3 d1))
(setq p5(polar (polar p1 a1 (* 4.5 d1)) a2 (* 0.25 d1)))
(command "dim" "leader" p1 p3)
(command)(command)
(entdel(entlast))
(command "pline" p1 p3 p4 p5 p2 "")
(command "pedit" "L" "S" "X")
(if(and(> (angle p5 p2)(* 0.5 pi))(< (angle p5 p2)(* 1.5 pi)))
   (command "Dtext" "J" "R"
       (polar p2 pi (*(getvar "dimtxt")(getvar"dimscale")))
       (*(getvar "dimtxt")(getvar"dimscale")) 0)
   (command "Dtext"
       (polar p2 0 (*(getvar "dimtxt")(getvar"dimscale")))
       (*(getvar "dimtxt")(getvar"dimscale")) 0)
)
)
(DEFUN C:PA ()
   (PROMPT "\nSETS LAYER BY ENTERING NAME OR SELECTING ENTITY   ALIAS PA")
   (SETQ X(GETSTRING "\nENTER LAYER NAME OR P TO SELECT EXISTING ENTITY: "))
   (IF(= X "P")(C:SL)(COMMAND "LAYER" "S" X "" ))
   (PROMPT "\n(c) by Ken Jolly 1994")
   (PRINC)
   )
(DEFUN C:1()
   (COMMAND "OFFSET" ".0625")
   (PRINC)
   )
(DEFUN C:2()
   (COMMAND "OFFSET" ".125")
   (PRINC)
   )
(DEFUN C:3()
   (COMMAND "OFFSET" ".1875")
   (PRINC)
   )
(DEFUN C:4()
   (COMMAND "OFFSET" ".25")
   (PRINC)
   )
(DEFUN C:5()
   (COMMAND "OFFSET" ".3125")
   (PRINC)
   )
(DEFUN C:6()
   (COMMAND "OFFSET" ".375")
   (PRINC)
   )
(DEFUN C:7()
   (COMMAND "OFFSET" ".4375")
   (PRINC)
   )
(DEFUN C:8()
   (COMMAND "OFFSET" ".500")
   (PRINC)
   )
(DEFUN C:9()
   (COMMAND "OFFSET" ".5625")
   (PRINC)
   )
(DEFUN C:10()
   (COMMAND "OFFSET" ".625")
   (PRINC)
   )
(DEFUN C:11()
   (COMMAND "OFFSET" ".6875")
   (PRINC)
   )
(DEFUN C:12()
   (COMMAND "OFFSET" ".75")
   (PRINC)
   )
(DEFUN C:13()
   (COMMAND "OFFSET" ".8125")
   (PRINC)
   )
(DEFUN C:14()
   (COMMAND "OFFSET" ".875")
   (PRINC)
   )
(DEFUN C:15()
   (COMMAND "OFFSET" ".9375")
   (PRINC)
   )
(DEFUN C:DR ()
  (COMMAND "DIM" "RAD")
  (PRINC)
  )
(defun C:2C ()
(command "circle" "2p")
(princ)
)
(defun C:3C ()
(command "circle" "3p")
(princ)
)
(defun C:FS ()
(command "fillet" "r" "0" "")
(command "fillet")
(princ)
)
(defun C:FR ()
ss(setq a(getstring "\nEnter Radius :"))
(command "fillet" "r" a "")
(command "fillet")
(princ)
)
(defun C:D ()
(setvar "osmode" 107)
(command "dist" )
(princ)
)
(defun C:ZW ()
(command "zoom" "w")
(princ)
)
(defun C:ZP ()
(command "zoom" "p")
(princ)
)
(defun C:ZE ()
(command "zoom" "e")
(princ)
)
(defun C:DA ()
   (command "dim" "align")
   (princ)
   )
(DEFUN C:ZD ()
   (COMMAND "ZOOM" "D")
   )
(DEFUN C:ON ()
(SETQ B(GETVAR "DWGNAME"))
(SETQ B(STRCAT "CURRENT DWG IS : " B))
(PROMPT B)
(SETQ A(GETSTRING "\nEnter drawing name to open : "))
(COMMAND "SAVE" "")
(COMMAND "OPEN" A)
(PROMPT "FAST OPEN by Ken Jolly 95")
(PRINC)
)
(DEFUN C:BOX()
(SETQ OS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(SETQ A1(GETREAL "\nEnter horizontal dimension or <> to select points: "))
(IF(= A1 NIL)(C:BO1))
(SETQ A3(GETREAL "\nEnter vertical dimension: "))
(SETQ A2(GETVAR "VIEWCTR"))
(SETQ AX(CAR A2)AY(CADR A2))
(SETQ BX(+ AX A1)BY(+ AY A3))
(SETQ P1(LIST BX AY)P2(LIST BX BY)P3 (LIST AX BY))
(COMMAND "PLINE" A2 P1 P2 P3 A2 "")
(SETVAR "OSMODE" OS)
(PROMPT "\nBox by Ken Jolly 95")
(PRINC)
)
(DEFUN C:BO1()
(SETVAR "ORTHOMODE" 0)
(SETQ A (GETPOINT "\nSELECT 1ST POINT: ")
B (GETPOINT A "\nSELECT 2ND POINT: "))
(SETQ AX(CAR A)AY(CADR A)BX(CAR B)BY(CADR B))
(SETQ P1(LIST AX BY)P2(LIST BX AY))
(COMMAND "PLINE" A P1 B P2 A "")
(SETVAR "OSMODE" OS)
(PROMPT "\nBox by Ken Jolly 95")
(PRINC)
)

yy5heng

楼主有研究哟！
我还是习惯用自己的。

htm

每个程序能加点说明更好，要不别人搞不清楚是干什么的。

TLHMQH

3楼楼主说的对。看明白的人，自己会编；看不明白的人，不知有什么用。应加点说明。

wei209

学习了,呵呵!

egos

都是他自己定义的快捷键  不适合其他人使用的

xmchy

但是可以参考啊，还是有用的！

TLHMQH

细一看，确实有参考价值，研究中。

hh222222

看天书一样，希望把中文说明加上

gccghl

写得不错，就是最好把功能写上，好让所有人都能知道用途。

and2008

楼主也不介绍一下,看了一头雾水

TLHMQH

快捷键的另一种定义方法，思路可鉴。

fjwlt

没有什么说明，像我们这种不懂编程的，真的看不懂啊

HHL_814

虽然很多函数，但不知用途，如能标注一下更好，否则，就是编程者本人时间长了也难记住。

dr.peanut

很实在的快捷键啊！应该支持的！