一个测量立面图点标高的程序。
本帖最后由 millermin 于 2011-12-1 11:35 编辑贡献一个自编的求点标高的程序。基线可以是水平线，即普通的标高问题。也可以是标高有变化的曲线，比如桥面上的构筑物，或者路面的围墙挡土墙等基线不平的情况。欢迎指正。自己觉得可以用，但构思不算巧妙，算是笨方法。
(defun c:test()
(vl-load-com)
(setq acadobject (vlax-get-acad-object))
(setq acaddocument (vla-get-activedocument acadobject))
(setq mspace (vla-get-modelspace acaddocument))
(setq bl (car (entsel "\n CHOOSE a BASE LINE:")))
(setq blv (vlax-ename->vla-object bl)
blst (vlax-curve-getstartpoint blv)
blend (vlax-curve-getendpoint blv))
(setq blstx (car blst))
(setq blendx (car blend))
(setq blsty (cadr blst))
(setq blendy (cadr blend))
(if (> blstx blendx)
(progn
(setq x0 blstx)
(setq blstx blendx)
(setq blendx x0)
)
)
(while (= "")
(setq tp (getpoint "\n CHOOSE A POINT TO CHECK LEVEL:"))
(if (< blstx (car tp) blendx)
(progn
(if (= blsty blendy)
(setq hei (- (cadr tp) blendy))
(progn
(setq tpinser(distpoint tp blv))
(setq hei(- (cadr tp) (cadr tpinser)))
)
)
(print (strcat "THIS POINT LEVEL IS:""-------------" "[ " (rtos hei) " ]"))
(prin1)
)
)
(if (or (> blstx (car tp)) (< blendx (car tp)))
(progn
(if (= blsty blendy)
(progn
(setq hei (- (cadr tp) blendy))
(print (strcat "THIS POINT LEVEL IS:""-------------" "[" (rtos hei) "]"))
(prin1)
)
(progn
(print (strcat"---------------------------------------------" "THIS POINT IS INVALID "))
(prin1)
)
); end if
) ; end progn
) ;end if
); end while
)
(defun distpoint(sp vlacurve)
(setq sp1 (list (car sp)(- (cadr sp) 100000) 0.0))
(setq sp2 (list (car sp)(+ (cadr sp) 100000) 0.0))
(setq downv (vlax-make-safearray vlax-vbdouble'(0 . 2)))
(vlax-safearray-fill downv sp1)
(setq upv (vlax-make-safearray vlax-vbdouble'(0 . 2)))
(vlax-safearray-fill upv sp2)
(setq addlinev (vla-addline mspace upv downv))
(setq crossv (vla-IntersectWith vlacurve addlinev acExtendNone))
(setq addline (vlax-vla-object->ename addlinev))
(command "erase" addline "")
(setq cross (vlax-safearray->list (vlax-variant-value crossv)))
)
能增加图面标注 的功能就更好
页:
[1]