有用的lisp小工具集合

<FONT face=宋体>在工作中随手编的一些小程序，简单实用，趁有空的时候在这里慢慢的贴出来，说不定能帮大伙一点小忙。欢迎试用和提意见：

1）这个小程序用于选取图中的text实体，计算其数字和：
</FONT>
<DIV >
<DIV class=smallfont style="MARGIN-BOTTOM: 2px"><FONT face=宋体>代码:</FONT></DIV>
<DIV class=smallfont style="MARGIN-BOTTOM: 2px">
<FONT face=宋体>;;;拾取数字求和       
(defun c:pickad        (/ ss n totn adn)
  (prompt "\n拾取数字求和: ")
  (setq        ss (ssget '((0 . "TEXT")))
        n  0
  )
  (setq totn 0.0)
  (while (setq en (ssname ss n))
    (setq adn (atof (cdr (assoc 1 (entget en)))))
    (setq totn (+ totn adn))
    (setq n (1+ n))
  )
  (princ (strcat "\n数字和: "))
  (princ totn)
  (princ)
)</FONT></DIV>
<DIV class=smallfont style="MARGIN-BOTTOM: 2px"><FONT face=宋体></FONT> </DIV>
<DIV class=smallfont style="MARGIN-BOTTOM: 2px"><FONT face=宋体></FONT> </DIV>
<DIV class=smallfont style="MARGIN-BOTTOM: 2px"><FONT face=宋体>或简单</FONT><FONT face=宋体,verdana,arial,helvetica>代码:</FONT></DIV>
<DIV class=smallfont style="MARGIN-BOTTOM: 2px"><FONT face=宋体>(defun c:pickad1 (/ psub1 ss totn)                ;拾取数字和(可作减法)
  (defun psub1 (ss / tot n en adn)
    (setq tot 0.0
          n   0
    )
    (while (setq en (ssname ss n))
      (setq adn (atof (cdr (assoc 1 (entget en)))))
      (setq tot        (+ tot adn)
            n        (1+ n)
      )
    )
    tot
  )

  (prompt "\n拾取数字求差: ")
  (prompt "\n请先选择被减的数字: ")
  (setq        ss   (ssget '((0 . "TEXT")))
        totn (psub1 ss)
  )
  (prompt "\n再选择要减去的数字: ")
  (setq        ss   (ssget '((0 . "TEXT")))
        totn (- totn (psub1 ss))
  )
  (princ (strcat "\n数字和: "))
  (princ totn)
  (princ)
)</FONT></DIV>
<DIV class=smallfont style="MARGIN-BOTTOM: 2px"> </DIV></DIV>

<><FONT face=宋体 size=2>改变已有的圆角半径：点选圆角弧，输入新半径值，自动重新圆角。
我用它修改过道路转角半径，还算不错：</FONT></P><P><FONT face=宋体 size=2></FONT> </P><P><FONT face=宋体 size=2>这个程序基于这样的想法：
作图的时候，要作的对象在图中已有同类的实体，则点取这个同类的实体，程序根据其类型调用相应的绘制命令。
更有意义的是：程</FONT></P><P>;;;LCMD.LSP
;;;</P><P>;;;</P><P>(defun c:lcmd( / ss en nl nc nlt ladd n cc ent nthk ntp)
  (setvar "cmdecho" 0) </P><P>;;;主程序</P><P>  (setq en (entsel "\n请选择目标实体: "))
  (if en (progn
    (setq eent (entget (car en))
          ntp (cdr (assoc 0 eent))
          nc (cdr (assoc 62 eent))            ;颜色
          nlt (cdr (assoc 6 eent))            ;线型
          nl (cdr (assoc 8 eent))             ;层
          nthk (cdr (assoc 39 eent))          ;厚度
          nelv (caddr (trans (cdr (assoc 10 eent)) 0 1))        ;高度
    )
    (if nc (setvar "cecolor" nc) (setvar "cecolor" "bylayer"))
    (if nlt (setvar "celtype" nlt) (setvar "celtype" "bylayer"))
    (setvar "clayer" nl)
    (cond
      ((= ntp "LINE") (command "line"))
      ((= ntp "POLYLINE") (command "pline"))
      ((= ntp "ARC") (command "arc"))
      ((= ntp "3DFACE") (command "3dface"))
      ((= ntp "SOLID") (command "solid"))
      ((= ntp "INSERT") (command "insert"))
      ((= ntp "CIRCLE") (command "circle"))
      ((= ntp "TEXT")
       (setvar "textstyle" (cdr (assoc 7 eent)))
       (setvar "textsize" (cdr (assoc 40 eent)))
       (command "text")
      )
      ((= ntp "DIMENSION")
      )
      ((= ntp "INSERT")
       (setq nin (cdr (assoc 2 eent)))
       (setvar "isname" nin)
       (command "insert")
      )
      (t)
    ) ;cond
   ) ;progn
  )  ;if</P><P>  (princ)
)</P>

不错.可以减少绘图量

第二个程序不错，我曾下载了一个类似的程序，改天也贴上来。