如何在拖动多段线一拐点的过程中面积实时改变

changyiran

附件中的多段线是我随意画出来的，画出多段线后自动在中心位置添加了面积（亩），这些我都用程序实现了，但是这个多段线的面积有可能和想要的面积不一致，因此我就会通过拖动多段线任一拐点来调整面积，在拖动过程中如何实时的使之前自动注记的面积变成拖动中多段线的面积呢？请大神们指教。

spp_wall

可以用字段

changyiran

spp_wall 发表于 2014-11-22 11:41
可以用字段

大侠能详细些不？应该是用反应器把

newbuser

changyiran 发表于 2014-11-22 12:35
大侠能详细些不？应该是用反应器把

如果我没猜错的话，楼主大人应该是新浪博客里叫做小萝卜头的那个版主吧。我见过你的作品，也挺不错的。

77077

应该是反应器。

ivde

field regen后自动更新

newbuser

2. (vl-load-com)
   
3. (defun c:c1 (/)
   
4.   (setq e (car (entsel "\n 请选择多边形==>>  ")))
   
5.   (setq e_obj (vlax-ename->vla-object e))
   
6.   (vla-getboundingbox e_obj 'minpt 'maxpt)
   
7.   (setq p1 (vlax-safearray->list minpt))
   
8.   (setq p2 (vlax-safearray->list maxpt))
   
9.   (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2));;求两点中点
   
10.   (setq mj (rtos (vla-get-area e_obj) 2 3))
    
11.   (entmake
    
12.     (list '(0 . "TEXT")
    
13.           (cons 1 mj)
    
14.           (cons 10 mid)
    
15.           (cons 40 (* (vla-get-area e_obj) 0.0001))
    
16.     )
    
17.   )
    
18.   (setq wjb (cdr (assoc 5 (entget (entlast)))))
    
19.   (setq wjl (list wjb))
    
20.   (setq objlt (list e_obj))        ;图元名转换为VLA对象
    
21.   (setq        vrl (vlr-pers
    
22.               (vlr-object-reactor objlt wjl '((:vlr-modified . c-2l)))
    
23.             )
    
24.   )
    
25.   (princ)                                ;静默退出
    
26. )
    
27. (defun c-2l (notifier-object
    
28.              reactor-object
    
29.              parameter-list
    
30.              /
    
31.             )
    
32.   (setq mj (rtos (vla-get-area notifier-object) 2 3))
    
33.   (vla-getboundingbox notifier-object 'minpt 'maxpt)
    
34.   (setq p1 (vlax-safearray->list minpt))
    
35.   (setq p2 (vlax-safearray->list maxpt))
    
36.   (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2)) ;;求两点中点
    
37.   (setq we (handent (car (vlr-data reactor-object)))) ;获取文本图元名
    
38.   (setq wel (entget we))
    
39.   (setq wel (subst (vl-list* 10 mid) (assoc 10 wel) wel))
    
40.   (setq wel (subst (vl-list* 1 mj) (assoc 1 wel) wel))
    
41.   (setq
    
42.     wel        (subst (vl-list* 40 (* (vla-get-area notifier-object) 0.0001))
    
43.                (assoc 40 wel)
    
44.                wel
    
45.         )
    
46.   )
    
47.   (entmod wel)                                ;更新文本图元表
    
48. )
    
49. 
    

(vl-load-com)<br /> (defun c:c1 (/)<br />   (setq e (car (entsel "\n 请选择多边形==>>  ")))<br />   (setq e_obj (vlax-ename->vla-object e))<br />   (vla-getboundingbox e_obj 'minpt 'maxpt)<br />   (setq p1 (vlax-safearray->list minpt))<br />   (setq p2 (vlax-safearray->list maxpt))<br />   (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2));;求两点中点<br />   (setq mj (rtos (vla-get-area e_obj) 2 3))<br />   (entmake<br />     (list '(0 . "TEXT")<br />           (cons 1 mj)<br />           (cons 10 mid)<br />           (cons 40 (* (vla-get-area e_obj) 0.0001))<br />     )<br />   )<br />   (setq wjb (cdr (assoc 5 (entget (entlast)))))<br />   (setq wjl (list wjb))<br />   (setq objlt (list e_obj))        ;图元名转换为VLA对象<br />   (setq        vrl (vlr-pers<br />               (vlr-object-reactor objlt wjl '((:vlr-modified . c-2l)))<br />             )<br />   )<br />   (princ)                                ;静默退出<br /> )<br /> (defun c-2l (notifier-object<br />              reactor-object<br />              parameter-list<br />              /<br />             )<br />   (setq mj (rtos (vla-get-area notifier-object) 2 3))<br />   (vla-getboundingbox notifier-object 'minpt 'maxpt)<br />   (setq p1 (vlax-safearray->list minpt))<br />   (setq p2 (vlax-safearray->list maxpt))<br />   (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2)) ;;求两点中点<br />   (setq we (handent (car (vlr-data reactor-object)))) ;获取文本图元名<br />   (setq wel (entget we))<br />   (setq wel (subst (vl-list* 10 mid) (assoc 10 wel) wel))<br />   (setq wel (subst (vl-list* 1 mj) (assoc 1 wel) wel))<br />   (setq<br />     wel        (subst (vl-list* 40 (* (vla-get-area notifier-object) 0.0001))<br />                (assoc 40 wel)<br />                wel<br />         )<br />   )<br />   (entmod wel)                                ;更新文本图元表<br /> )<br /> <br />

小试了下牛刀，初步测试应该可以满足您的要求。

yoyoho

感谢newbuser分享程序!

USER2128

newbuser 发表于 2014-11-24 11:31
小试了下牛刀，初步测试应该可以满足您的要求。

感谢newbuser，感谢分享程序!

changyiran

各位大侠，我已经实现了，谢谢，用grread实现的