分享一段初学lisp的代码，将N个多段线首尾相连
本帖最后由 cchessbd 于 2023-3-23 11:13 编辑这个是最开始学lisp时候写的。工作上因为要用到。记得当时对着Autocad 自带的帮助函数，用记事本写了好几个晚上，
甚至有时候12点多才睡，也是佩服当时的自己。现在看来代码相当简陋。有时候还出问题。但是我现在也难找出问题症结。
我现在在黄总的列表排序函数基础上，又重新写了一个。依然还有些小问题：有时候相邻多段线无法用不同颜色区分。
不过顺序没啥问题了。
(HH:ssPts:Sort ss "x" 0.5)
感谢黄总的分享！真是造福了很多人。
;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 PLxPL00)
(MovePLx)
(princ)
)
(defun C:ddb2 ()
(slctPL00)
(setq PLx(reverse PL00))
(MovePLx)
(princ)
)
(princ) 实用的功能，前排点赞。 感谢分享，这个功能很实用！ 非常感谢分享，看看效果@
页:
[1]