GCD高程点z值修复[原创.附源码]

lioun4105

谢谢实用好工具

lioun4105

收藏了会用得着，谢谢分享

pusslica

虽然看不懂 但是觉得很厉害

li809

谢谢楼主的劳动成果！

16719080

不错，谢谢楼主的分享！

zwf100

为什么没改过来

zwf100

我正好需要相反的

aumyshow

谢谢分享
~~~~~~~~~~~~~~~

寒潮大冬瓜

;GCD设置cass定义的属性块gcd200插入点Z坐标的值写到高程属性(height值)中去
(defun C:GCD (/ SS JD I EN0 EN1 ENT0 ENT1 PT0 STR)
  (if (SETQ SS (ssget '((0 . "insert") (2 . "*"))))
    (progn
      (if (SETQ JD (getint "\n小数保留位数<4>: "))()(SETQ JD 4))
      (repeat (SETQ i (sslength SS))
                                (SETQ EN0  (ssname SS (SETQ i (1- i)))
                                        ENT0 (entget EN0)
                                        EN1  (entnext EN0)
                                        ENT1 (entget EN1)
                                )
                                (SETQ PT0 (cdr (assoc 10 ENT0))) ;_插入点
                                (SETQ STR (rtos (caddr PT0) 2 JD)) ;_新内容
                                (entmod (subst (cons 1 STR) (assoc 1 ENT1) ENT1))
                                (entupd EN0) ;_更新
      )
      (princ)
    )
  )
)

寒潮大冬瓜

;;;GCDD设置cass定义的属性块gcd中高程属性(标高或height值)为其插入点的z坐标
(DEFUN C:GCDD()(GCDD2024)(princ))
(defun GCDD2024(/ bt11 e h hh jd n s)
        (princ "GCDD设置cass定义的属性块gcd中高程属性(标高或height值)为其插入点的z坐标QXQ")
        (defun bt11 (e / s)
                (if (and (setq e (vlax-ename->vla-object e))
                                        (vla-Get-HasAttributes e)
                                )
                        (progn
                                (foreach x
                                        (vlax-safearray->list (vlax-variant-value (vla-GetAttributes e)))
                                        (if (OR (= "标高" (vla-Get-TagString x)) (= "height" (vla-Get-TagString x)))
                                 ;(if (= "标高" (vla-Get-TagString x))
                                               
                                                (setq s (cons (vla-Get-TextString x)s))
                                        )
                                )
                                (if s (car s))
                        )               
                )       
        )
        (if (and (or (setq JD (getint "\n小数保留位数<4>: "))
                                                 (setq jd 4)
                                         )
                                ;(setq s (ssget '((0 . "insert") (2 . "GC*"))))
                                (setq s (ssget '((0 . "insert")(2 . "GC*"))))
                                (setq n (sslength s))
                        )
                (while (and (setq e (ssname s (setq n (1- n))))
                                                 (setq h (bt11 e))
                                                 (setq h (read h))
                                                 (numberp h)
                                                 (setq h (atof (rtos h 2 jd)))
                                                 (setq e (vlax-ename->vla-object e))
                                                 (setq hh (vlax-get e 'InsertionPoint))
                                         )
                        (vlax-put e 'InsertionPoint (list (car hh)(cadr hh) h))
                )               
        )
)