(defun c:pljoin(/ #os1 ss i en ent
ss1 xlist ent_pt_list pt_list l_pt
l_pt_list pti l l_pt pt_s
xlist2 n m sort_list ptj
pt_e pt_x pt_y j
)
(setvar "cmdecho" 0)
(setq #os1 (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(princ "请选取需要合并的样条曲线或多段线集合:")
(setq ss (ssget '((0 . "spline,lwpolyline,polyline"))))
(setqi 0
ss1 (ssadd)
);获取曲线转换为多段线并生成新选择集ss1
(repeat (sslength ss)
(setq en (ssname ss i))
(setq ent (entget en))
(cond
((= (cdr (assoc 0 ent)) "SPLINE")
(command "pedit" en "y" "" "")
(ssadd (entlast) ss1)
)
((= (cdr (assoc 0 ent)) "POLYLINE")
(command "pedit" en "d" "")
(ssadd (entlast) ss1)
)
(t (ssadd en ss1))
)
(setq i (1+ i))
)
(setqi 0
xlist '()
);生成所有点集xlist、多段线始末点集ptlist
(setq pt_list '())
(repeat (sslength ss1)
(setq en (ssname ss1 i))
(setq ent (entget en))
(setq ent_pt_list
(mapcar
'(lambda (x) (cdr x))
(vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)
)
)
(setq xlist (append ent_pt_list xlist))
(setq pt_list (cons (car xlist) pt_list))
(setq pt_list (cons (last xlist) pt_list))
(setq i (1+ i))
)
(setqi 0
l_pt_list '()
);计算曲线的起点pt_s
(repeat (length pt_list)
(setq l_pt '())
(setq pti (nth i pt_list))
(setq l (apply '+ (mapcar '(lambda (x) (distance x pti)) xlist)))
(setq l_pt (cons pti l_pt))
(setq l_pt (cons l l_pt))
(setq l_pt_list (cons l_pt l_pt_list))
(setq i (1+ i))
)
(setqpt_s
(cadr
(assoc (apply 'max (mapcar '(lambda (x) (car x)) l_pt_list))
l_pt_list
)
)
)
(setqi 0
xlist2 '()
);对点集xlist进行排序生产xlist2
(if (> (length xlist) 30)
(setq m 30)
(setq m (length xlist))
)
(setq n (/ (length xlist) m))
(setqpti pt_s
sort_list xlist
)
(while sort_list
(setq
sort_list(vl-sort sort_list
'(lambda (e1 e2)
(< (distance pti e1) (distance pti e2))
)
)
)
(setq pt_x 0
pt_y 0
j 0
ptj t
)
(while (and (setq ptj (nth j sort_list)) (< j n))
(setq pt_e ptj)
(setq pt_x (+ pt_x (car ptj)))
(setq pt_y (+ pt_y (cadr ptj)))
(setq j (1+ j))
)
(setq xlist2 (cons (list (/ pt_x j) (/ pt_y j)) xlist2))
(setq sort_list (cdr (member ptj sort_list)))
(setq pti (car sort_list))
(setq i (1+ i))
)
(setq xlist2 (cons pt_e xlist2))
(setq xlist2 (cons pt_s (reverse xlist2)))
(command "pline" (car xlist2) "w" 0 "") ;生成多段线
(foreach i xlist2 (command i))
(command "")
(command "pedit" (entlast) "s" "")
(command "erase" ss1 "")
(command "undo" "e")
(setvar "osmode" #os1)
(princ)
)