切地形剖面图程序，望各位小东家园高手修改

xunzhao123 · 发表于 2014-5-26 16:25:59

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:t24 (/ E1 PTS SS E PL PT DIST H MINH MAXH PTLST CURVELEN LOWERH P1 l zoomp) (xdrx_begin)
(xdrx_document_ucson)
(setq e1 (car (xdrx_entsel "\n选择对象:" '((0 . "*line,arc")))))
(setq pts (xdrx_getsamplept e1))
(if (apply 'xdrx_isptoffscr pts)
(progn
(command "_zoom" "w" (apply 'mapcar (cons 'min pts)) (apply 'mapcar (cons 'max pts)) )
(setq zoomp t)
)
)
(setq ss (ssget "_F" pts '((0 . "*POLYLINE"))))
(if zoomp (command "_zoom" "_p"))
(xdrx_setsstodb ss 0)
(xdrx_document_ucsoff)
(while (setq e (xdrx_getentdata 0))
(setq pl (append pl (xdrx_entity_OrthoPrjInterSectWith e1 e 0)))
)
(setq pl
(vl-sort
pl
(function
(lambda (a b)
(< (vlax-curve-getParamAtPoint e1 (VLAX-CURVE-GETCLOSESTPOINTTO e1 (car a)))
(vlax-curve-getParamAtPoint e1 (VLAX-CURVE-GETCLOSESTPOINTTO e1 (car b)))
)
)
)
)
)
(setq pt (trans (getpoint "\n剖面图摆放位置:") 1 0))
(foreach a pl
(setq dist (vlax-curve-getDistAtPoint e1 (VLAX-CURVE-GETCLOSESTPOINTTO e1 (car a)))
h (last (cadr a))
)
(if (not minh)
(setq minh h maxh h)
(setq minh (min minh h)
maxh (max maxh h)
)
)
(setq ptlst (cons (list dist h 0) ptlst))
)
(setq curvelen (vlax-curve-getDistAtParam e1 (vlax-curve-getEndParam e1)))
(setq lowerh (- 10 (* 10 (fix (* minh 0.1)))))
(setq ptlst (mapcar '(lambda (x) (mapcar '+ pt x (list 0 lowerh 0))) ptlst))
(apply 'xdrx_line_make ptlst)
(xdrx_line1 pt (setq p1 (polar pt 0 curvelen)))
(xdrx_line1 pt (polar pt (* 0.5 pi) (+ (+ 20 (* 10 (fix (* 0.1 maxh)))) lowerh)))
(xdrx_line1 p1 (polar p1 (* 0.5 pi) (+ (+ 20 (* 10 (fix (* 0.1 maxh)))) lowerh)))
(entmake
(list '(0 . "TEXT")
'(67 . 0)
'(100
.
"AcDbText"
)
(cons 10 pt)
(cons 40 2.0)
(cons 1 (rtos (abs lowerh) 2 0))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
'(7 . "standard")
)
)
(entmake
(list '(0 . "TEXT")
'(67 . 0)
'(100
.
"AcDbText"
)
(cons 10 p1)
(cons 40 2.0)
(cons 1 (rtos (abs lowerh) 2 0))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
'(7 . "standard")
)
)
(xdrx_end)
)

st788796 · 发表于 2014-5-26 18:27:32

需要改什么呢？

xunzhao123 · 发表于 2014-5-26 20:03:21

st788796 发表于 2014-5-26 18:27
需要改什么呢？

程序加载时有问题提示没有定义

st788796 · 发表于 2014-5-26 20:08:36

加载 xdrxapi

杜流浪人 · 发表于 2014-5-26 21:13:57

自己去找晓东包装函数就可以了

xunzhao123 · 发表于 2014-5-26 21:53:03

杜流浪人发表于 2014-5-26 21:13
自己去找晓东包装函数就可以了

什么意思晓东包装函数在哪里？

xunzhao123 · 发表于 2014-5-26 21:55:24

st788796 发表于 2014-5-26 20:08
加载 xdrxapi

加载 xdrxapi？如何加载它

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

[他山之石] 切地形剖面图程序，望各位小东家园高手修改

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

点评

点评