lisp把多段线顶点连成表,lisp将多条线条合并成一条多段线

该楼层疑似违规已被系统折叠 隐藏此楼查看此楼

(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)

)