整体抬升高程点

ashleytgg

以前曾经遇到过，在南方CASS中整体抬升高程点的时候， 但没成功。最近查阅了网上的资料，（帖子见http://bbs.mjtd.com/forum.php?mod=viewthread&tid=96543&highlight=%B3%A3%D3%C3%BA%AF%CA%FD）

终于做成了一个小插件，觉得还是蛮有趣的，在此和大家分享下。

2. ;;30.3 [功能] 更改选定块的指定属性
   
3. ;; (MJ:PutTagTextStringByRef  (vlax-ename->vla-object (car (entsel))  )    "height" "900")
   
4. (defun MJ:PutTagTextStringByRef  (br tagname textstring / atts tag)
   
5.   (vl-load-com)
   
6.   (if (and
   
7.   (= (vla-get-hasattributes br) :vlax-true)
   
8.   (safearray-value
   
9.     (setq  atts
   
10.      (vlax-variant-value
    
11.        (vla-getattributes br)
    
12.      )
    
13.     )
    
14.   )
    
15.       )
    
16.     (foreach tag (vlax-safearray->list atts)
    
17.       (if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
    
18.   (vla-put-TextString tag textstring)
    
19.       )
    
20.     )
    
21.     (vla-update br)
    
22.   )
    
23. )
    
24. 
    
25. 
    
26. ;;  创建一个函数 把图中所有的块高程统一下调一定高度，同时把文字的高度也做相应的调整
    
27. (defun C:chagne_高程点_height (/ ss ent lst group_ent U h_det)
    
28.   (setq h_det (getreal "\n请输入要抬高的数值:"))
    
29.   (setq  ss
    
30.    (ssget (list (cons 0 "INSERT")))
    
31.   )
    
32.   (setq  i 0
    
33.   group_ent nil
    
34.   )
    
35.   (repeat (sslength ss)
    
36.     (setq group_ent (cons (ssname ss i) group_ent))
    
37.     (setq i (1+ i))
    
38.   )
    
39.   (setq group_ent (reverse group_ent))
    
40.   (mapcar '(lambda (x / u lst lst2 h_str)
    
41.        (setq lst   (entget x)
    
42.        U   (cdr (assoc 10 lst))
    
43.        U   (mapcar '+ U (list 0 0 h_det))
    
44.        h_str (rtos (caddr u) 2 2)
    
45.        )
    
46.        (setq lst2 (subst (append (list 10) U) (assoc 10 lst) lst))
    
47.        (entmod lst2)
    
48.        (MJ:PutTagTextStringByRef
    
49.          (vlax-ename->vla-object x)
    
50.          "height"
    
51.          h_str
    
52.        )
    
53.      )
    
54.     group_ent
    
55.   )
    
56. )

;;30.3 [功能] 更改选定块的指定属性<br /> ;; (MJ:PutTagTextStringByRef  (vlax-ename->vla-object (car (entsel))  )    "height" "900") <br /> (defun MJ:PutTagTextStringByRef  (br tagname textstring / atts tag)<br />   (vl-load-com)<br />   (if (and<br />   (= (vla-get-hasattributes br) :vlax-true)<br />   (safearray-value<br />     (setq  atts<br />      (vlax-variant-value<br />        (vla-getattributes br)<br />      )<br />     )<br />   )<br />       )<br />     (foreach tag (vlax-safearray->list atts)<br />       (if (= (strcase tagname) (strcase (vla-get-tagstring tag)))<br />   (vla-put-TextString tag textstring)<br />       )<br />     )<br />     (vla-update br)<br />   )<br /> )<br /> <br /> <br /> ;;  创建一个函数 把图中所有的块高程统一下调一定高度，同时把文字的高度也做相应的调整 <br /> (defun C:chagne_高程点_height (/ ss ent lst group_ent U h_det)<br />   (setq h_det (getreal "\n请输入要抬高的数值:"))<br />   (setq  ss<br />    (ssget (list (cons 0 "INSERT")))<br />   )<br />   (setq  i 0<br />   group_ent nil<br />   )<br />   (repeat (sslength ss)<br />     (setq group_ent (cons (ssname ss i) group_ent))<br />     (setq i (1+ i))<br />   )<br />   (setq group_ent (reverse group_ent))<br />   (mapcar '(lambda (x / u lst lst2 h_str)<br />        (setq lst   (entget x)<br />        U   (cdr (assoc 10 lst))<br />        U   (mapcar '+ U (list 0 0 h_det))<br />        h_str (rtos (caddr u) 2 2)<br />        )<br />        (setq lst2 (subst (append (list 10) U) (assoc 10 lst) lst))<br />        (entmod lst2)<br />        (MJ:PutTagTextStringByRef<br />          (vlax-ename->vla-object x)<br />          "height"<br />          h_str<br />        )<br />      )<br />     group_ent<br />   )<br /> )

13648893846

谢谢分享，学习了，支持单选框选全图选择否？

ashleytgg

13648893846 发表于 2018-11-10 11:15
谢谢分享，学习了，支持单选框选全图选择否？

可以自己改动ssget 函数啊，很简单的

13648893846

嗯！多谢多谢

happy336

谢谢分享，学习了

zwf100

楼主太帅了