马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
本帖最后由 newer 于 2018-12-15 15:28 编辑
函数
1、XD::Pnt:isPits 见: http://bbs.xdcad.net/thread-705797-1-1.html
2、xd::dimleaderindex:make 见:http://bbs.xdcad.net/thread-705795-1-1.html
[sell=5](defun c:XDTB_TJPolyVertex (/ #height e elev i inxs lst num p- p+ p1 p2 pt
pts v v- v+ x
)
(defun _drawindex (e)
(setq num (xdrx_polyline_numverts e)
i -1
)
(repeat num
(setq inxs (xd::polyline:-index+ e (setq i (1+ i))))
(setq p1 (xdrx_getpropertyvalue e "pointat" i)
p- (xdrx_getpropertyvalue e "pointat" (car inxs))
p+ (xdrx_getpropertyvalue e "pointat" (cadr inxs))
v- (mapcar
'-
p-
p1
)
v- (xdrx_vector_normalize v-)
v+ (mapcar
'-
p+
p1
)
v+ (xdrx_vector_normalize v+)
v (mapcar
'+
v-
v+
)
v (xdrx_vector_normalize v)
)
(setq p1 (xd::pnt:setz p1 0.0))
(if (not (xd::pnt:isPits e p1))
(progn
(setq v (xdrx_vector_negate v))
)
)
(setq p2 (mapcar
'+
p1
(xdrx_vector_product v #height)
)
)
(xd::dimleaderindex:make (itoa (1+ i)) #height p1 p2 (/ #height 5.0)
"_none" 0
)
)
)
(XD::Doc:CheckAcadVersion '>= "2008" "")
(if (and
(setq #height (getreal "\n输入字高<退出>:"))
(setq e (car (xdrx_entsel "\n拾取多段线<退出>:" '((0 . "*POLYLINE")))))
)
(progn
(xdrx_begin)
(xdrx_sysvar_push '("dimzin" 0))
(if (= "POLYLINE" (car (xdrx_object_classname e)))
(xdrx_polyline_convertfrom e)
)
(xdrx_polyline_compress e t)
(setq pts (xdrx_getpropertyvalue e "vertices")
elev (xdrx_getpropertyvalue e "elevation")
)
(if (xd::pnts:isclockwise pts)
(progn
(setq pts (reverse pts))
(xdrx_curve_reverse e)
)
)
(xd::text:init 1)
(_drawindex e)
(if (setq pt (getpoint "\n表格插入点<退出>:"))
(progn
(setq lst (list (list "多段线顶点坐标" " " " " " ") (list "编号"
"X坐标"
"Y坐标"
"Z坐标"
)
)
)
(setq i 0)
(setq lst (append
lst
(mapcar
'(lambda (x)
(setq i (1+ i))
(list (itoa i) (rtos (cadr x) 2 4) (rtos
(car x)
2 4
)
(rtos elev 2 1)
)
)
pts
)
)
)
(xd::table:makefromlist lst pt #height (/ #height 2.0))
)
)
(xdrx_sysvar_pop)
(xdrx_end)
)
)
(princ)
)
[/sell] |