【K:GetClsUcsLst 】获取撑开的多边形UCS点表
本帖最后由 kucha007 于 2024-5-15 23:50 编辑绘制撑开的多边形，这里提供另外一种思路
以前大多使用区域覆盖来曲线救国，类似这篇帖子：撑开面积区域
;获取撑开的多边形UCS点表
(defun K:GetClsUcsLst (/ PTLst TgtPT TmpLst)
(defun *error* (x);出错函数
(redraw)
)
(if (car (setq PTLst (list (getpoint "\n→请指定起点或空格退出"))))
(progn
(while
(setq TgtPT
(if (>= (length PTLst) 2) ;至少两个点
(if (>= (length PTLst) 3) ;三个点
(progn
(initget "U")
(getpoint (car PTLst) "\n→请指定下一点或空格结束 [撤回(U)]: ")
)
(progn
(initget 1 "U")
(getpoint (car PTLst) "\n→请指定下一点或 [撤回(U)]:")
)
)
(progn
(initget 1 "S");非空
(getpoint (car PTLst)"\n→请指定下一点")
)
)
);第二个点
(redraw)
(cond
((and (eq (type TgtPT) 'STR) (eq TgtPT "U"))
(setq PTLst (cdr PTLst))
)
((eq (type TgtPT) 'LIST)
(setq PTLst (cons TgtPT PTLst))
)
) ;根据关键词返回坐标点
(if (>= (length PTLst) 3);多边形
(progn
(setq TmpLst (cons (Last PTLst) PTLst));闭合坐标
(mapcar '(lambda (a b) (grdraw a b 1 -1)) TmpLst (cdr TmpLst)) ;画线
)
(mapcar '(lambda (a b) (grdraw a b 1 -1)) PTLst (cdr PTLst)) ;画线
)
) ;下一点OR撤回
(redraw)
)
)
(if (>= (length PTLst) 3) PTLst)
)
用法：
(if (setq UCSLst (K:GetClsUcsLst))
(K:MakeLWPOLYLINE Nil T UCSLst)
)
补充一个基础函数
;点表生成多段线
(defun K:MakeLWPOLYLINE (WCS Clsd PTLst / PT)
(entmakeX
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length PTLst))
)
(if Clsd (list (cons 70 1)))
(mapcar '(lambda (PT)
(cons 10
(if WCS PT (trans PT 1 0))
)
)
PTLst
)
)
)
)
页:
[1]