(grread)拖动多义线顶点动态显示面积

【KAIXIN】

2. (defun c:KK ()
   
3. (setq loop T)
   
4. (setvar "osmode" 37)
   
5. (setq p0 (getpoint "pick point:"))
   
6. (setq e (ssget "c" (polar p0 (/ pi 4) 0.001)
   
7. (polar p0 (* 1.25 pi) 0.001)))
   
8. (setq ent (ssname e 0))
   
9. (setq obj (vlax-ename->vla-object ent)
   
10. pp (vlax-curve-getclosestpointto obj (trans p0 1 0))
    
11. n (fix (vlax-curve-getparamatpoint obj pp)))
    
12. (setq pts (variant-value (vla-get-coordinates obj)))
    
13. (while loop
    
14. (setq p (grread T))
    
15. (setq k (car p)
    
16. p (cadr p))
    
17. (if (= k 3)(setq loop nil))
    
18. (vlax-safearray-put-element pts (* n 2) (car p))
    
19. (vlax-safearray-put-element pts (1+ (* n 2))(cadr p))
    
20. (vla-put-coordinates obj pts)
    
21. (princ "\n")
    
22. (princ (vlax-curve-getarea obj))
    
23. )
    
24. )

(defun c:KK () <br /> (setq loop T) <br /> (setvar "osmode" 37) <br /> (setq p0 (getpoint "pick point:")) <br /> (setq e (ssget "c" (polar p0 (/ pi 4) 0.001) <br /> (polar p0 (* 1.25 pi) 0.001))) <br /> (setq ent (ssname e 0)) <br /> (setq obj (vlax-ename->vla-object ent) <br /> pp (vlax-curve-getclosestpointto obj (trans p0 1 0)) <br /> n (fix (vlax-curve-getparamatpoint obj pp))) <br /> (setq pts (variant-value (vla-get-coordinates obj))) <br /> (while loop <br /> (setq p (grread T)) <br /> (setq k (car p) <br /> p (cadr p)) <br /> (if (= k 3)(setq loop nil)) <br /> (vlax-safearray-put-element pts (* n 2) (car p)) <br /> (vlax-safearray-put-element pts (1+ (* n 2))(cadr p)) <br /> (vla-put-coordinates obj pts) <br /> (princ "\n") <br /> (princ (vlax-curve-getarea obj)) <br /> ) <br /> )

该贴已经同步到 【KAIXIN】的微博

xxxooo

非常好，感谢大大无私分享

tianbeiyuan

好东西，看看学学

zbwei120

程序不错，因工作需要能否加个通过输入固定面积的数值，点击某个点后，程序能自动计算使该点沿指定方向移动一定距离，使得面积刚好为输入的面积数据。谢谢。

cabinsummer

zbwei120 发表于 2011-12-10 15:23
程序不错，因工作需要能否加个通过输入固定面积的数值，点击某个点后，程序能自动计算使该点沿指定方向移动 ...

楼主的程序仅仅是演示动态。如果要按你的要求，没必要动态。

zbwei120

那倒是，楼上能否帮个忙？谢谢。

梦与现实交替

真是厉害啊

byghbcx

17.(vlax-safearray-put-element pts  (car p))
18.(vlax-safearray-put-element pts (1+ (* n 2))(cadr p))
程序有问题，没有针对二维多段线
(cond ((= (vla-get-objectname obj) "AcDbPolyline")
         (vlax-safearray-put-element pts (* n 2) (car p))
         (vlax-safearray-put-element pts (1+ (* n 2))(cadr p)))
((= (vla-get-objectname obj) "AcDb2dPolyline")
         (vlax-safearray-put-element pts (* n 3) (car p))
         (vlax-safearray-put-element pts (1+ (* n 3))(cadr p)))
)

【KAIXIN】

byghbcx 发表于 2011-12-12 11:21
17.(vlax-safearray-put-element pts  (car p))
18.(vlax-safearray-put-element pts (1+ (* n 2))(cadr  ...

2006测试通过，GIF图片就是演习，不过谢谢朋友的提醒，我看看

jack093

面积值显示在屏幕上就好了

wgl4810

可以实现面积直接显示在屏幕上吗？

wgl4810

wgl4810 发表于 2012-9-15 14:21
可以实现面积直接显示在屏幕上吗？

动态显示在拖动点的边上。