[LISP程序]：一个实用的LISP程序

hqd9639

我写的一个智能粗糙度标度程序，能自动捕捉法线。对机械专业的朋友很有用。

为方便您修改为你自已合用的程序,源代码公布如下：
;;;
;;;2002/11/26
;;;WRITE BY HQD
;;;
(PRINC "***智能化粗糙度标注程序***COPYRIGHT (C) 2002 BY HQD9639***RUN COMMAND: ROU")
;;;****************************************************************

(DEFUN MYERROR (S)
    (IF (/= S "FUNCTION CANCELLED")
        (PRINC (STRACT "\NERROR:" S))
    )

     (SETVAR "OSMODE" OSD)
     (SETVAR "CMDECHO" CMD)
     (SETVAR "BLIPMODE" BLIP)
     (SETVAR "TEXTSTYLE" TXTSTY)

    (SETQ *ERROR* OLDERR)
    (PRINC)
)

;;;*************CONVERT ANGLE IN DEGREES TO RADIANS*****************

    (DEFUN DTR(A)
          (* PI (/ A 180.0))
    )

;;;*****************************标注加工面粗糙度**************************

(DEFUN C:ROU(/ BLIP CMD OSD TXTSTY IP CU TDATA RANGE1 IRA PT1 PT2 PT3 PT4 PT6
               SS1 ST1 IRT IRT1 MT MT1)

      (SETQ OLDERR *ERROR*
                   *ERROR* MYERROR)

      (SETQ BLIP (GETVAR "BLIPMODE"))
      (SETQ CMD (GETVAR "CMDECHO"))
      (SETQ OSD (GETVAR "OSMODE"))
      (SETQ TXTSTY (GETVAR "TEXTSTYLE"))

      (SETVAR "CMDECHO" 0)
      (SETVAR "BLIPMODE" 0)
      (SETVAR "OSMODE" 512)

      (COMMAND "STYLE" "FOR_ROU" "TXT.SHX" "2.1" "" "" "" "" "")

      (INITGET 1)   
      (SETQ IP (GETPOINT "\N 选择标注点: "))     
      (COMMAND "CIRCLE" IP 0.0001)
      (SETQ CU (OSNAP IP "INTERS"))
      (ENTDEL (ENTLAST))
      (SETQ TDATA NIL)
      (IF CU
         (PROGN (SETQ RANGLE1 (ANGLE IP CU))
                (SETQ IRA (+ RANGLE1 (DTR 90)))
         )
         (SETQ IRA (DTR 90.0)
               TDATA T
         )
      )
      (SETQ PT1 (POLAR IP (- IRA (DTR 30)) 8.0))
      (SETQ PT2 (POLAR IP (- IRA (DTR 30)) 4.0))
      (SETQ PT3 (POLAR IP (+ IRA (DTR 30)) 4.0))
      (SETQ PT4 (POLAR IP IRA 5.4))
      (SETQ PT6 (POLAR IP (- IRA (DTR 90.0)) 10.0))
      (SETVAR "OSMODE" 0)
      (COMMAND "LINE" PT1 IP "")
      (SETQ SS1 (SSADD))
      (SETQ SS1 (SSADD (ENTLAST) SS1))

      (COMMAND "LINE" IP PT3 "")
      (SETQ SS1 (SSADD (ENTLAST) SS1))

      (COMMAND "LINE" PT3 PT2 "")
      (SETQ SS1 (SSADD (ENTLAST) SS1))

      (SETQ ST1 (GETSTRING "\N 请输入粗糙度值: "))
      (IF (< IRA 0.0)
          (SETQ IRA (+ IRA (DTR 360)))
      )
      (IF (> IRA (DTR 360))
          (SETQ IRA (- IRA (DTR 360)))
      )
      (IF (AND (>= IRA (DTR 180.5)) (< IRA (DTR 360.5)))
          (SETQ IRA (- IRA (DTR 180)))
      )
      (SETQ IRT (- IRA (DTR 90)))
      (SETQ IRT1 (/ (* IRT 180) PI))

      (COMMAND"_TEXT" "M" PT4 IRT1 ST1)
      (SSADD (ENTLAST) SS1)

      (IF (= TDATA T)                                            ;;;当标注点在空白处时
          (PROGN (SETQ SCT (GETSTRING "\N 要缩放吗[Y/N <N>]? "))
                 (IF (OR (= SCT "Y") (= SCT "Y"))
                     (PROGN (INITGET 7)
                            (SETQ SCP (GETREAL "\N 请输入缩放倍数: "))
                            (COMMAND "SCALE" SS1 "" IP SCP)
                     )
                 )
          )
          (PROGN (SETQ MT (GETSTRING "\N 要翻转吗?Y/N <N>: "))  ;;;当标注点在实体处时  
                 (SETQ MT1 (GETVAR "MIRRTEXT"))
                 (SETVAR "MIRRTEXT" 0)
                 (IF (OR (= MT "Y") (= MT "Y"))
                     (PROGN (COMMAND "MIRROR" SS1 "" IP PT4 "Y")
                            (COMMAND "MIRROR" (SSGET "P") "" IP PT6 "Y")
                     )
        
                 )
                 (SETVAR "MIRRTEXT" MT1)
         )
     )
     (SETVAR "OSMODE" OSD)
     (SETVAR "CMDECHO" CMD)
     (SETVAR "BLIPMODE" BLIP)
     (SETVAR "TEXTSTYLE" TXTSTY)
     (SETQ *ERROR* OLDERR)
     (PRINC)
  )
;;;*********************************************************************

lijiao

有几点意见供hqd9639考虑：
1、粗糙度符号的大小应根据绘图比例来确定，当绘图比例改变后，该符号要能够随之改变大小。
2、符号的位置应由用户在屏幕上指定。
3、标注后如何重新编辑？
************************************************
我有一个程序供大家参考。
加载后，用"ccd"调用。
该程序在ACAD 2000、ACAD2002调试通过。

lijiao

想听听你的意见。

hqd9639

最初由 lijiao 发布
[B]有几点意见供hqd9639考虑：
1、粗糙度符号的大小应根据绘图比例来确定，当绘图比例改变后，该符号要能够随之改变大小。
2、符号的位置应由用户在屏幕上指定。
3、标注后如何重新编辑？
************************... [/B]

1。粗糙度符号的大小应该是确定的，不应该随绘图比例改变。
2。上述程序是让你选取插入点呀？
3。可以在特性编辑。

lijiao

1、我认为给用户的选择项太多，使用不太方便。
2、请用一下我的那个程序，看看效果（当移动光标确定粗糙度方向时，可以用键盘改变粗糙度的数值）。

hqd9639

最初由 lijiao 发布
[B]1、我认为给用户的选择项太多，使用不太方便。
2、请用一下我的那个程序，看看效果（当移动光标确定粗糙度方向时，可以用键盘改变粗糙度的数值）。 [/B]

看样子每个人都觉得自已的东西才是最好的！

试用过你的程序：

lijiao

不要急噪，可能是你的设置有问题。

aeo

看了一下,没标一个,交互的太多.
写这个就是为省时间的,你这么写和insert没两样.
我觉的如每次输比例就不好(lijiao的比较好)插入点时(initget "S比例"),毕竟改比例不会每次都用.
给出插入点后,下一点拉出方向,再给值.

lijiao

你的当前字体可能设置了固定高度。

hqd9639

最初由 aeo 发布
[B]看了一下,没标一个,交互的太多.
写这个就是为省时间的,你这么写和insert没两样.
我觉的如每次输比例就不好(lijiao的比较好)插入点时(initget "S比例"),毕竟改比例不会每次都用.
给出插入点后,下一点拉出方向,再给... [/B]

还是仔细看看吧！
其实这个程序只需输入插入点和粗糙度值，后面的判断程序段特殊情况下才用到，你可以不要这段。它的特点就是能自动捕获选取点的法线，而不需手工旋转去得到一个不准确的插入角度。

a789456123

是不是太多了点呀.

菜鸟当家

最初由 陈伯雄 发布
[B]我有些纳闷：
AutoCAD Mechanical从R14版本就已经有了完整的工程图各种符号添加功能，至今一直随着版本在更新，大家为什么还在研究自己写的程序？难道会比AutoCADM中的功能更为完整和可靠么？ [/B]

AUTOCAD2000里有粗糙度的符号吗？我怎么找来找去找不到啊，
只有一些电路上符号啊，有的话，请告知在哪里？谢谢！

独孤雪

感觉hqd9639 的程序好用一些
但有几点想法：
好象没有不加工表面的标注

zhp8149

我同意陈老师的观点，不过如果有可能，也可以自己编写一些更好的程序，一是提高自己的水平，而是得到更好的效果。

qjydz

我觉得很多2次开发是多余的，mdt6是机械版的CAD，里面好多功能都有，用了都说好。不信你试试，保准迷住你。