[LISP程序]：鼠标拖动多义线顶点动态显示包容面积

lsjjm

鼠标拖动多义线顶点动态显示包容面积
[PHP]
(defun c:test ()
  (setq loop T)
  (setvar "osmode" 37)
  (setq p0 (getpoint "pick point:"))
  (setq e (ssget "c" (polar p0 (/ pi 4) 0.001)
                     (polar p0 (* 1.25 pi) 0.001)))
  (setq ent (ssname e 0))
  (setq obj (vlax-ename->vla-object ent)
        pp  (vlax-curve-getclosestpointto obj (trans p0 1 0))
        n   (fix (vlax-curve-getparamatpoint obj pp)))
  (setq pts (variant-value (vla-get-coordinates obj)))
  (while loop
    (setq p (grread T))
    (setq k (car p)
          p (cadr p))   
    (if        (= k 3)(setq loop nil))
    (vlax-safearray-put-element pts (* n 2) (car p))
    (vlax-safearray-put-element pts (1+ (* n 2))(cadr p))
    (vla-put-coordinates obj pts)
    (princ "\n")
    (princ (vlax-curve-getarea obj))  
  )
)

[/PHP]

梦断江南

写的不错,建议加上对多义线的判别.

tsh007

请问，我在CAD2002里面怎么不行啊？

它山之石

lsjjm长老又回来了吗？
grread时再加上捕捉就更准确了。当未选到点时程序会出错退出。

tsh007

在2005里面可以用了，如果面积调整时在图形中部来个显示框显示调整面积就更好，另外，
再具体操作时，用鼠标要想调整到指定的面积也不容易控制

zb_lou

非常感谢你提供这个程序！

啵浪鼓

好像没用啊,我装载后选择线段时出现以下提示:

TEST pick point:; 错误: 参数类型错误: lselsetp nil
TEST pick point:; 错误: no function definition: VLAX-ENAME->VLA-OBJECT

ionic

楼上的老兄没有加载AutoLISP扩展，应先输入
(vl-load-com)