分享一段初学lisp的代码，将N个多段线首尾相连

cchessbd

这个是最开始学lisp时候写的。工作上因为要用到。记得当时对着AutoCAD 自带的帮助函数，用记事本写了好几个晚上，
甚至有时候12点多才睡，也是佩服当时的自己。现在看来代码相当简陋。有时候还出问题。但是我现在也难找出问题症结。

我现在在黄总的列表排序函数基础上，又重新写了一个。依然还有些小问题：有时候相邻多段线无法用不同颜色区分。
不过顺序没啥问题了。


(HH:ssPts:Sort ss "x" 0.5)
感谢黄总的分享！真是造福了很多人。

cchessbd

;DDB        多段线首尾相连，按X坐标升序，注意：同一个坐标的会按y坐标升序连接后再连后面的。
;DDB1        多段线首尾相连，按图元顺序，也可手选，按选择顺序
;DDB2        多段线首尾相连，按图元反序
;比如纵断面的dmx是分幅断开的，但是纵断面一般是连续的，此时就需要用到这个。
;这样出图就只要对一次高程，里程，不用每次计算。

(defun SORTx (PLST)
(vl-sort PLST
        (function (lambda (e1 e2)
                         (< (car(cadr e1)) (car(cadr e2)))))
))

(defun SubLST (LST START N1)
  (if (and (< START (length LST)) (> N1 0))
    (cons (nth START LST) (SubLST LST (1+ START) (1- N1)))
  )
)

(defun MovePLx (/ n ent pl pl0 Cx)
(setq n 0)
(repeat (sslength ss)
        (setq PL (car (car (SubLST PLx (1+ n) 1))))
        (setq PL0 (car(car(SubLST PLx n 1))))
        (vl-cmdf "_move" PL ""  (vlax-curve-getStartPoint PL) (vlax-curve-getEndPoint PL0))
        (setq ent (entget (car(car(SubLST PLx 0 1)))))
        (setq Cx (cdr(assoc 62 ent)))
        (if (and (= 0 (rem n 2)))
        (setq Cx (rem (+ 3 Cx) 7))
        )
        (vl-cmdf "chprop" PL "p" "" "c" Cx "")
        (setq n (1+ n))
)
(princ)
)

(defun slctPL00 ()
;(setq PL (car (entsel "\n选取多段线:")))
;(princ (vlax-curve-getEndPoint PL))

(setq ss (ssget '((0 . "*POLYLINE"))))
(vl-load-com)
(setq
PL00 nil
PLn0 nil
n (sslength ss)
)
(repeat (sslength ss)
(setq n (1- n));-1放头部,(setq n (sslength ss))
(setq PL (ssname ss n))
(setq PL0 (ssname ss (1- n)))
(setq PLn0 (cons (list PL) PLn0))
(setq PL00 (cons (list PL (vlax-curve-getStartPoint PL) (vlax-curve-getEndPoint PL)) PL00))
;(setq n (1+ n));+1放尾部,(setq n 0)
)
(princ)
)

(defun C:ddb ()
(slctPL00)
(setq PLx  (SORTx PL00))
(MovePLx)
(princ)
)

(defun C:ddb1 ()
(slctPL00)
(setq PLx  PL00)
(MovePLx)
(princ)
)

(defun C:ddb2 ()
(slctPL00)
(setq PLx  (reverse PL00))
(MovePLx)
(princ)
)
(princ)

lxl217114

实用的功能，前排点赞。

sirlowlam1

感谢分享，这个功能很实用！

weijiewen

非常感谢分享，看看效果@