多段线生成临时偏移线，然后阳角进行连线
本帖最后由 weimeng555 于 2024-5-11 20:04 编辑如附件测试图纸思路，麻烦各位路过大佬出手。感激不尽{:1_1:}
本帖最后由 czb203 于 2024-5-12 19:21 编辑
(defun c:tt (/ c:tt dist en en1 getplinepts lst-remove-dups p1 p2 p3 p4 pt ptlst ptlst1 xd_convex_hull xd_convex_hull_sort_an xdl-sort xj-getlwpt)
(vl-load-com)
(defun XDL-SORT(lst sortlst / n)
(if (listp sortlst)
(if (listp (car sortlst))
(setq sortlst (reverse sortlst))
(setq sortlst (list sortlst))
)
(setq sortlst (list (list nil sortlst)))
)
(foreach n sortlst
(setq lst (vl-sort lst '(lambda (s1 s2)
(apply (cadr n) (list (if (car n) (nth(car n) s1)s1)
(if (car n) (nth(car n) s2)s2))))))
)
)
(defun lst-remove-dups(pts fuzz / pt x)
(cond ((=(length pts)1) pts)
(t(setq pt(car pts))
(cons pt(vl-remove-if '(lambda(x)(equal pt x fuzz))
(lst-remove-dups(cdr pts)fuzz))
)
))
)
(defun XD_convex_hull_sort_an(pt an ls / re)
(setq re (mapcar '(lambda(x) (list (rem (+ (* 2 pi)(- (angle pt x) an))(* 2 pi))(distance pt x) x)) ls))
(setq re (XDL-SORT re '((0 <)(1 >))))
(last(car re))
)
(defun XD_convex_hull (lst / re tblst AN BG RESULT)
(setq lst (lst-remove-dups lst 0))
(setq lst (XDL-SORT lst '((0 <)(1 <))));;按XY增排序
(setq bg (car lst)
an (/ pi -2)
)
(setq tblst (list bg))
(while
(and (> (length lst) 2)
(not (and (> (length tblst) 1) (= (car tblst) (last tblst)))
)
)
(setq result (XD_convex_hull_sort_an (car tblst) an (vl-remove (car tblst) lst)))
(setq an (angle (car tblst) result))
(setq tblst (cons result tblst))
)
tblst
)
(defun GetPlinePts( name / ents pts)
(setq ents (entget name))
(while (setq ents (member (assoc 10 ents) ents))
(setq pts (append pts (list (cdar ents))))
(setq ents (cdr ents))
)
pts
)
(defun xj-getlwpt (enn / ent lst)
(setq ent (entget enn))
(setq lst (list))
(foreach x ent (if (= (car x) 10) (setq lst (cons (cdr x) lst))))
lst
)
(setq dist (getdist
(strcat
"\n输入偏移距离:<"
(rtos (getvar "OFFSETDIST"))
">"
)
)
)
(if (null dist)
(setq dist (getvar "offsetdist"))
(setvar "offsetdist" dist)
)
(setq en (car (entsel "\n请选择线:"))
ptlst (xj-getlwpt en)
ptlst (XD_convex_hull ptlst)
)
(command "offset" dist en pause "")
(setq en1 (entlast)
ptlst1 (xj-getlwpt en1)
ptlst1 (XD_convex_hull ptlst1)
)
(if (> (length ptlst) 2)
(progn
(setq ptlst(cdr (reverse (cdr (reverse ptlst))))
ptlst1 (cdr (reverse (cdr (reverse ptlst1))))
)
(mapcar '(lambda (x y) (entmake (list '(0 . "LINE") (cons 10 x) (cons 11 y)))) ptlst ptlst1)
)
)
(entdel en1)
(princ)
) 好像第一个点间没连线吧？ 这个比较简单，我写过ARX版的 bai2000 发表于 2024-5-13 08:22
好像第一个点间没连线吧？
这里测试图，确实是漏掉了:lol
页:
[1]