lioun4105 发表于 2017-9-4 20:57:37

谢谢实用好工具

lioun4105 发表于 2017-9-14 23:58:02

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

pusslica 发表于 2017-9-17 15:22:43

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

li809 发表于 2017-9-18 16:22:24

谢谢楼主的劳动成果！

16719080 发表于 2018-1-15 19:36:33

不错，谢谢楼主的分享！

zwf100 发表于 2020-7-3 21:07:52

为什么没改过来

zwf100 发表于 2020-7-4 21:31:20

我正好需要相反的

aumyshow 发表于 2021-3-6 22:41:42

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

寒潮大冬瓜 发表于 2024-5-16 00:25:51

;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)
    )
)
)

寒潮大冬瓜 发表于 2024-5-16 00:31:20

;;;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))
                )               
        )
)
页: 1 2 [3]
查看完整版本: GCD高程点z值修复[原创.附源码]