根据大于3点的三维多段线首尾高程分配给中间个点
根据大于3点的三维多段线首尾高程分配给中间个点
;; 测量选定曲线上两点之间的距离
(defun apkl (ENOBJ p1 p2 / DIST DIST1 DIST2 EN ENOBJ OSM P1 P2)
;;;来源：QQ群友：GreenWood(181976640)。属QQ群：SP编程,e派<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>箱,摄影24942984
;(setq ENOBJ (CAR (ENTSEL)))
;(setq p1 (getpoint "\n选择曲线上的一点："))
;(setq p2 (getpoint "\n选择曲线上的另一点："))
(setq dist1 (vlax-curve-getDistAtPoint enobj p1))
(setq dist2 (vlax-curve-getDistAtPoint enobj p2))
;(print "\n测量段曲线长度：")
(setq dist (abs (- dist1 dist2)))
dist
)
(defun vxs (e / i v lst ppp)
(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(setq ppp (reverse lst) )
(append (list(vlax-curve-getpointatparam e 0)) ppp )
)
;;;;;;;;
(defunddx ( Polylinep1gccc / x xdb xh coord temp0 temp1PolylineObj aaa n)
(setq PolylineObj (vlax-ename->vla-object Polyline ) )
(setq aaa (vxs Polyline) ) (setq n (length aaa))
(setq xdb (apply 'append (mapcar'(lambda(x)(setq aaa(cdr aaa)) (list(cons (- n (length aaa)) x)))aaa)))
(foreach xxdb
(if (< (distance (list (nth 1 x) (nth 2 x) ) (list (car p1) (cadr p1)) )0.0500)
(setq xh (-(car x) 1))
;(setq xh nil )
)
);;;;;;
;; 找出第一个索引位置的坐标
(setq coord(vla-get-Coordinate PolylineObjxh))
;;; 改变坐标
;(setq temp(+ (vlax-safearray-get-element (vlax-variant-value coord) 0) 1))
(setq temp0 (car p1)
temp1(cadr p1)
)
(setq coord(vlax-variant-value coord))
(vlax-safearray-put-element coord 0 temp0)
(vlax-safearray-put-element coord 1 temp1)
(vlax-safearray-put-element coord 2 gccc)
(vla-put-Coordinate PolylineObj xh coord)
(vla-Update PolylineObj)
;;;;;;;
)
;;;;;;;
(defun c:bg (/ ENOBJ p1 p2 s1 s2 p3dist gcc bz dist1 xgc y)
(setq ENOBJ (CAR (ENTSEL "\n请选择线段")))
(setq p1 (getpoint "\n选择曲线上的一点："))
(setq s1 (getreal "\n请输入该点标高："))
(setq p2 (getpoint "\n选择曲线上的另一点："))
(setq s2 (getreal "\n请输入该点标高："))
(setq dist (apkl ENOBJ p1 p2 ))
(setq gcc (- s1 s2))
(setq bz (/ gcc dist))
(foreachy (vl-remove(last (cdr(vxs ENOBJ) ))(cdr(vxs ENOBJ) ) )
(setq dist1 (apkl ENOBJ y p2 ) )
(setq xgc (+ s2 (* dist1 bz )))
(ddx ENOBJyxgc )
(entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos xgc 2 3)) (cons 10 y ) (cons 40 1.0)))
)
(ddx ENOBJp1s1 )
(entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos s1 2 3)) (cons 10 p1 ) (cons 40 1.0)))
(ddx ENOBJp2s2 )
(entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos s2 2 3)) (cons 10 p2 ) (cons 40 1.0)))
(princ)
)
页:
[1]