ashleytgg 发表于 2018-11-9 23:00:42

整体抬升高程点

本帖最后由 ashleytgg 于 2018-11-9 22:59 编辑

以前曾经遇到过，在南方CASS中整体抬升高程点的时候， 但没成功。最近查阅了网上的资料，（帖子见http://bbs.mjtd.com/forum.php?mod=viewthread&tid=96543&highlight=%B3%A3%D3%C3%BA%AF%CA%FD） 终于做成了一个小插件，觉得还是蛮有趣的，在此和大家分享下。;;30.3 [功能] 更改选定块的指定属性
;; (MJ:PutTagTextStringByRef(vlax-ename->vla-object (car (entsel)))    "height" "900")
(defun MJ:PutTagTextStringByRef(br tagname textstring / atts tag)
(vl-load-com)
(if (and
(= (vla-get-hasattributes br) :vlax-true)
(safearray-value
    (setqatts
   (vlax-variant-value
       (vla-getattributes br)
   )
    )
)
      )
    (foreach tag (vlax-safearray->list atts)
      (if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(vla-put-TextString tag textstring)
      )
    )
    (vla-update br)
)
)


;;创建一个函数 把图中所有的块高程统一下调一定高度，同时把文字的高度也做相应的调整
(defun C:chagne_高程点_height (/ ss ent lst group_ent U h_det)
(setq h_det (getreal "\n请输入要抬高的数值:"))
(setqss
   (ssget (list (cons 0 "INSERT")))
)
(setqi 0
group_ent nil
)
(repeat (sslength ss)
    (setq group_ent (cons (ssname ss i) group_ent))
    (setq i (1+ i))
)
(setq group_ent (reverse group_ent))
(mapcar '(lambda (x / u lst lst2 h_str)
       (setq lst   (entget x)
       U   (cdr (assoc 10 lst))
       U   (mapcar '+ U (list 0 0 h_det))
       h_str (rtos (caddr u) 2 2)
       )
       (setq lst2 (subst (append (list 10) U) (assoc 10 lst) lst))
       (entmod lst2)
       (MJ:PutTagTextStringByRef
         (vlax-ename->vla-object x)
         "height"
         h_str
       )
   )
    group_ent
)
)

13648893846 发表于 2018-11-10 11:15:53

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

ashleytgg 发表于 2018-11-10 13:47:22

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

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

13648893846 发表于 2018-11-10 14:53:15

嗯！多谢多谢

happy336 发表于 2019-10-28 23:18:57

谢谢分享，学习了

zwf100 发表于 2020-7-4 20:39:47

楼主太帅了{:1_1:}

寒潮大冬瓜 发表于 2024-6-16 20:15:46

很好→很棒！很好~很棒！！很好……很棒！！！
页: [1]
查看完整版本: 整体抬升高程点