[LISP程序]：一个动态生成序号球的小程序

lsjjm

一个动态生成序号球的小程序
点击零件上的点，序号球（圆，号码）及引线末端随鼠标动态移动。可连续生成，号码自增。本例序号球大小尤其适用于英制机械图纸。
[php]
(defun c:test ()
  (vl-load-com)
  (setq h (* (getvar "dimscale")(getvar "dimtxt"))
        r h
       sn 1)
  (while sn
    (setq p0 (getpoint "\nPick Insert Point:"))
    (setq loop t)
    (command "circle" p0 r)
    (setq ceo (vlax-ename->vla-object (entlast)))
    (vl-cmdf "text" "j" "m" p0 h 0 (itoa sn) "")
    (setq teo (vlax-ename->vla-object (entlast)))
    (command "leader" p0 (polar p0 (/ pi 4) 0.1)  "" "" "n")
    (setq le (entlast))
    (setq leo (vlax-ename->vla-object le))
    (setq p1 (vlax-curve-getstartpoint le))
    (while loop
      (setq p (grread T))
      (setq k (car p)
            p (cadr p))
      (if (= k 3)(setq loop nil))
      (vla-put-center ceo (vlax-3d-point p))
      (vla-put-textalignmentpoint teo (vlax-3d-point p))
      (vla-update ceo)
    (setq sl (vlax-make-safearray vlax-vbdouble '(0 . 5)))
       (setq sa (vlax-safearray-fill sl (append p1 (polar p (angle p p1) r))))
       (vla-put-coordinates leo sa)
    )
    (setq sn (1+ sn))
    (setq ct (getstring "\nContinue<N>?"))
    (if (= (strcase ct) "N")(setq sn nil))
  )
)

[/php]

ycao

程序不错，值得参考！

longamei

怎么用啊

cyxzime

程序不错，值得参考！

lc_shi

运行时，显示错误。
n Unknown command "N"
error:bad argument:AcDbcurve 2130147168
不知何故？
我用2005 版

li_seagull

谢谢 lsjjm ，能不能帮我改一下一个球引出两条线,就是说要标注两个位置.

狂刀

命令: test
Pick Insert Point:未知命令“TEST”。按 F1 查看帮助。

错误: 三维点错误: 0

命令: test
Pick Insert Point:未知命令“TEST”。按 F1 查看帮助。

Continue<N>?

Pick Insert Point:
0.180000

未知命令“TEST”。按 F1 查看帮助。
应用程序错误: 命令输入时发送的类型无效

错误: 参数类型错误: 二维/三维点: nil

NREAD

(if (= (getvar "dimscale") 0)
(setq h (* 1 (getvar "dimtxt")) )
(setq h (* (getvar "dimscale")(getvar "dimtxt")) )
)

zxq0220

程序不错。改了一下，可在R14上使用。
[php]
(defun c:test (/ h r sn p0 ceo teo leo p1 k p)
(setq h (getvar "dimscale")
       h (* (if (= h 0) 1 h) (getvar "dimtxt"))
       r h sn 1)
(while (setq p0 (getpoint "\nPick Insert Point:"))
  (command "circle" p0 r)
  (setq ceo (entget (entlast)))
  (command "text" "j" "m" p0 h 0 (itoa sn) "")
  (setq teo (entget (entlast)))
  (command "leader" p0 (polar p0 (/ pi 4) 0.1)  "" "" "n")
  (setq leo (entget (entlast)))
  (setq p1 (cdr (assoc 10 leo)) k 1)
  (while (/= k 3)
   (setq p (grread T))
   (setq k (car p) p (cadr p))
   (setq ceo (subst (cons 10 p) (assoc 10 ceo) ceo))
   (entmod ceo)
   (setq teo (subst (cons 11 p) (assoc 11 teo) teo))
   (entmod teo)
   (setq p (polar p (angle p p1) r))
   (setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))
   (entmod leo)
  )
  (setq sn (1+ sn))
)
(princ)
)
[/php]

bddlwzh

一个不错的程序，但有一个BUG，大家讨论一下，就是当半径r等于整数时，如果打开捕捉后移动鼠标，移动r个单位后出错退出，错误：“Automation 错误。 点表无效”。也就是说如果sa中的两顶点坐标成一点时，(vla-put-coordinates leo sa)是通不过的，为什么？

zfylxy

程序不错，值得参考

yxianfo

最后的程序不错，但使用时应特别注意以下两点:
   1.若当前文字样式设定了字高，则序号始终为0，不会递增，因此不能设定当前文字样式的字高，即当前文字样式必须选字高为0的样式。
2.不能打开“对象捕捉”功能（按钮），否则绘制的数字与圆圈会随鼠标的点击而分离，且指引线未绘制出来。
  当然，上述要求可在程序中增加适当的语句来实现。