多点自动连线
本帖最后由 117g 于 2023-12-12 21:36 编辑命令:dlx 功能:选中的点按X轴递增的方向依次连接
(defun c:DLX ()
(setq points (ssget '((0 . "POINT"))))
(if (zerop (setq num-points (sslength points)))
(princ "\nNo points selected.")
(progn
(setq sorted-points (list))
(repeat num-points
(setq ent (ssname points 0))
(setq pt (cdr (assoc 10 (entget ent))))
(setq sorted-points (cons pt sorted-points))
(setq points (ssdel ent points))
)
(setq sorted-points (vl-sort sorted-points (function (lambda (a b) (< (car a) (car b))))))
(command "_pline")
(repeat num-points
(setq pt (car sorted-points))
(setq sorted-points (cdr sorted-points))
(command pt)
)
)
)
(princ)
)
(整理贴)
本帖最后由 xyp1964 于 2023-11-7 16:52 编辑
(defun c:tt1 ()
(if (and (setq ss (ssget '((0 . "POINT"))))
(setq nn (sslength ss))
)
(progn
(setq ptn '() i 0)
(repeat nn
(setq pt(cdr (assoc 10 (entget (ssname ss i))))
ptn (cons pt ptn)
i (1+ i)
)
)
(setq ptn (vl-sort ptn '(lambda (a b) (< (car a) (car b)))))
(command "pline")
(foreach pt ptn (command pt))
(command "")
)
)
(princ)
)
(defun c:tt2 (/ ptn)
(if (setq ss (ssget '((0 . "POINT"))))
(progn
(setq i -1)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq ptn (cons (cdr (assoc 10 (entget s1))) ptn))
)
(command "pline")
(foreach pt (vl-sort ptn '(lambda (a b) (< (car a) (car b)))) (command pt))
(command "")
)
)
(princ)
)
(defun c:tt2 (/ i ss s1 ptn)
(and(setq i 0 ss(ssget '((0 . "POINT"))))
(while(setq s1(ssname ss i))
(setq i(1+ i)
ptn(cons(cdr(assoc 10 (entget s1)))ptn))
)
(entmakex(vl-list*'(0 . "lwpolyline")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90(length ptn))
(mapcar(function(lambda(x)(cons 10 x)))
(vl-sort ptn(function(lambda (a b) (< (car a) (car b))))))))
)
) https://www.bilibili.com/video/BV1rv4117749/?spm_id_from=333.337.search-card.all.click&vd_source=821e79a69050957434301a9219740425 后面好像少了个空格 xyp1964 发表于 2023-11-6 19:23
大佬对点的处理方式比我的方便太多了,码住学习下
感谢楼主分享 llsheng_73 发表于 2023-11-8 23:06
感谢大佬指点 收藏,自动连线 不错的帖子 顶一下
页:
[1]
2