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

yshf

程序不错！

dabingrain

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 "\r")
    
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 "\r") <br />                 (princ (vlax-curve-getarea obj)) <br />         ) <br /> )

tongtong3489

还好，就是不在屏幕上

柴月二号

dabingrain 发表于 2016-6-20 16:37

能不能加个运算使结果显示为    原结果*0.0015

tianbeiyuan

好东西，看看学学

xxxooo

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