[原创]一个检查高程点高程和注记值是否相符的小程序

杜阳 · 发表于 2012-3-11 12:47:02

把源代码发出来共同研究一下啊谢谢了

004 · 发表于 2012-12-3 02:02:23

都过去几年了,能贴个源码吗?

xiabin68 · 发表于 2012-12-11 22:16:33

这是个什么思路

YJ647372 · 发表于 2013-7-1 08:37:24

谢谢！试试是否好用！

zjsmlzp · 发表于 2013-7-7 16:39:04

用不了，不知大家用得怎么样？

语默有常 · 发表于 2013-9-27 23:34:17

请发个源码给我，qq:40224382，谢谢！

gzxl · 发表于 2013-9-29 11:33:06

应该是检查Z值和height属性的一致性吧

xujinhua · 发表于 2014-1-22 11:19:15

谢谢楼主...这个有用

spp_wall · 发表于 2014-7-3 11:17:54

谢谢！！！！！！！！

wmz · 发表于 2014-7-4 08:58:08

(vl-load-com)

;;;测点高程值与高程注记匹配
(defun c:GCPP(/ s n m s1 s2 s3 d0 d1 d5 dd h0 h x y z k)
(setq s (ssget "X" '((8 . "GCD")(0 . "INSERT"))))
(setq n (sslength s) m 0 k 0)
   (repeat n
      (setq  s1 (ssname s m) m (+ m 1))
      (setq  s2 (ENTGET s1))
      (setq  d0 (assoc 10 s2))
      (setq  H0 (last d0))
      (setq x (MJ:GetTagTextStringByRef (vlax-ename->vla-object s1) "integer"))
      (setq y (MJ:GetTagTextStringByRef (vlax-ename->vla-object s1) "decimal"))
      (setq z (MJ:GetTagTextStringByRef (vlax-ename->vla-object s1) "height"))
   (cond ((/= z nil)(setq d1 (atof z)))
      ((and(/= x nil)(/= y nil))(setq d1 (atof (strcat x "." y))))
   )
   (if (> (abs(- d1 H0)) 0.05)
      (progn
(setq h d1 k (+ k 1))
         (setq d5 (list (car d0) (cadr d0) (caddr d0) h))
            (setq dd (subst d5 d0 s2))
            (entmod dd)
   ))
   )
   (alert (strcat "共匹配 " (rtos k 2 0) "点"))
)
;; [功能] 取得选定块的指定属性
;; (MJ:GetTagTextStringByRef (vlax-ename->vla-object (car (entsel))) "设计")
(defun MJ:GetTagTextStringByRef (br tagname / atts tag str)
  (if (and
(= (vla-get-hasattributes br) :vlax-true)
(safearray-value
   (setq atts
   (vlax-variant-value
   (vla-getattributes br)
   )
   )
)
   )
(foreach tag (vlax-safearray->list atts)
   (if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(setq str (vla-get-TextString tag))
   )
)
  )
  str
)

账号		自动登录	找回密码
密码			注册

[原创]一个检查高程点高程和注记值是否相符的小程序

本帖子中包含更多资源