动态生成序号球（vla-put-coordinates的用法）

hicoffee 发表于 2008-2-15 10:14:00

;一个动态生成序号球的小程序 ;点击零件上的点，序号球（圆，号码）及引线末端随鼠标动态移动。可连续生成，号码自增。本例序号球大小尤其适用于英制机械图纸。(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))   ) )     一个不错的程序，但有一个BUG，大家讨论一下，就是当半径r等于整数时，如果打开捕捉后移动鼠标，移动r个单位后出错退出，错误：“Automation 错误。点表无效”。也就是说如果sa中的两顶点坐标成一点时，(vla-put-coordinates leo sa)是通不过的，为什么？

ZZXXQQ 发表于 2008-2-15 13:04:00

本帖最后由作者于 2008-2-15 13:10:57 编辑

LEADER的起点和终点不能是一点。这样试试

(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))))
 (if (> (distance (polar p (angle p p1) r) p0) 0.0) (vla-put-coordinates leo sa))
)
(setq sn (1+ sn))
(setq ct (getstring "\nContinue<N>?"))
(if (= (strcase ct) "N")(setq sn nil))
)
)

;这是纯LISP
(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))
(if (> (distance p p0) 0.0) (entmod leo))
)
(setq sn (1+ sn))
)
(princ)
)

hicoffee 发表于 2008-2-15 13:38:00

是的，但我想知道是不是vla-put-coordinates函数不能接受同一点组成的数组结构？

ZZXXQQ 发表于 2008-2-15 16:24:00

不是vla-put-coordinates函数的问题是LEADER实体生成问题

hicoffee 发表于 2008-2-15 16:31:00

明白，也就是说在实体生成的过程中出错了，谢谢。

h_fog 发表于 2017-9-20 21:16:36

绝世好文，不得不顶

305341043 发表于 2023-3-23 19:33:16

学习了

Klein 发表于 2023-3-23 21:07:58

grread学习了

页: [1]

明经CAD社区's Archiver

动态生成序号球（vla-put-coordinates的用法）