所有的点按照顺时针方向排序
代码产生背景：在建筑模型绘图中，由于打灯光的需要，在建筑模型框架的内部需要做，万家灯火的框架，做成蜂窝状，每家窗户都有一个灯，模拟现实的灯光效果，通常是做成层层跑动的灯光，两路或者3路不同颜色变换的灯光，为了达到这种灯光效果，就需要CAD绘图员画出带灯孔的板和带凹槽的卡板，所以这个代码就出现了。对建筑模型行业了解的绘图员，都明白，灯孔板和卡板都是有规律的，所以用代码实现肯定能省不少时间，减少加班时间。
引用猫老师的话：“珍惜生命，提高工作效率”。
下图为：自动画万家灯火的灯孔板和带凹槽的卡板
代码的功能：点按照顺时针方向排序
http://bbs.mjtd.com/data/attachment/forum/201804/05/152158fo33bbn3joubgbuo.gif
(defun ssinters(sss / i num obj1 obj2 j interpts ptlist)
(setqi 0
num (sslength sss)
)
(while (< i (1- num))
(setq obj1 (ssname sss i)
obj1 (vlax-ename->vla-object obj1)
j (1+ i)
)
(while (< j num)
(setq obj2 (ssname sss j)
obj2 (vlax-ename->vla-object obj2)
interpts (vla-intersectwith
obj1
obj2
0
)
interpts (vlax-variant-value interpts)
)
(if (> (vlax-safearray-get-u-bound interpts 1) 0)
(progn
(setqinterpts
(vlax-safearray->list interpts)
)
(while (> (length interpts) 0)
(setq ptlist (cons (list (car interpts)
(cadr interpts)
(caddr interpts)
)
ptlist
)
)
(setq interpts (cdddr interpts))
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
ptlist
)
(defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N);By 自贡黄明儒
;;1 点列表排序
(defun sortpts (PTS FUN xyz FUZZ)
(vl-sort pts
'(lambda (a b)
(if (not (equal (xyz a) (xyz b) fuzz))
(fun (xyz a) (xyz b))
)
)
)
)
;;2 排序先后
(defun sortpts1 (PTS KEY FUZZ)
(setq Key (vl-string->list Key))
(foreach xyz (reverse Key)
(cond ((< xyz 100)
(setq fun >)
(setq xyz (nth (- xyz 88) (list car cadr caddr)))
)
(T
(setq fun <)
(setq xyz (nth (- xyz 120) (list car cadr caddr)))
)
)
(setq Pts (sortpts Pts fun xyz fuzz))
)
)
;;3 本程序主程序
(cond
((= (type ssPts) 'PICKSET)
(repeat (setq n (sslength ssPts))
(if (and (setq e (ssname ssPts (setq n (1- n))))
(setq en (entget e))
)
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
)
)
(mapcar 'last (sortpts1 lst KEY FUZZ))
)
((Listp ssPts)
(cond
((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
((= (type (car ssPts)) 'ENAME)
(foreach e ssPts
(if (setq en (entget e))
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
)
)
(mapcar 'last (sortpts1 lst KEY FUZZ))
)
(T
(cond ((equal key "X") (vl-sort ssPts '>))
((equal key "x") (vl-sort ssPts '<))
)
)
)
)
)
)
;; Clockwise-p-Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented
(defun LM:Clockwise-p ( p1 p2 p3 )
((lambda ( n ) (< (car (trans p2 0 n)) (car (trans p1 0 n)))) (mapcar '- p1 p3))
)
;;164.3 [功能] 多段线端点列表 By 自贡黄明儒
;;示例(HH:PtLists (car (entsel)))
(defun HH:PtLists (en)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
)
)
;(/ osmode_bak clayer_bak ss ss7 ss2 en pts n);猫老师编辑器变量自动生成
(defun c:tt (/ osmode_bak clayer_bak ss ss7 ss2 p1 pts p2 p3 en n ss1sss ptx lst pt)
;----开始系统变量备份----
(command "undo" "be")
(setvar "cmdecho" 0);_关闭命令提示
(setq osmode_bak (getvar "osmode"));_记录捕捉
(setvar "osmode" 0);_关闭捕捉
(setq clayer_bak (getvar "clayer"));_记录当前图层
;----;----;----;----;----;----;----;----;----
;按照图层分选择集，为了求2个图层对象的交点
(setq ss (ssget))
(command "select" ss"")
(setq ss7 (ssget "p" '((8 . "ngc7"))))
(command "select" ss "")
(setq ss2 (ssget "p" '((8 . "ngc2"))))
(setq en (ssname ss7 0))
(setq pts (HH:PtLists en));HH:PtLists多段线端点列表 By 自贡黄明儒
(setq n 0)
(if (< (fix(vlax-curve-getEndParam en)) 2)
(progn
(dengg);一条线的时候
)
)
(if (> (fix(vlax-curve-getEndParam en)) 1)
(progn
(deng);多条线的时候
)
)
;----结束系统变量还原----
(setvar "osmode" osmode_bak);_还原捕捉
(setvar "clayer" clayer_bak);_还原图层
(setvar "cmdecho" 1);_打开命令提示
(command "undo" "e")
(princ);_关闭程序返回值
)
;(/ p1 pts p2 p3 en n ss1 ss2 sss ptx lst pt)
(defun deng ()
(setq p1 (nth 0 pts)
p2 (nth 1 pts)
p3 (nth 2 pts)
)
(if (= (LM:Clockwise-p p1 p2 p3) nil); 判断顺时针和逆时针Clockwise-p-Lee Mac
(progn (setq pts(reverse pts)))
)
;重复动作
(repeat
(fix(vlax-curve-getEndParam en))
(command "line" (nth n pts) (nth (1+ n) pts) "")
(setq ss1 (entlast))
(command "select" ss1 ss2 "")
(setq sss (ssget "p" ))
(setq ptx (ssinters sss));ssinters求交点，明经论坛里面的
(command "erase" ss1 "")
(setq lst (append (list(nth n pts) (nth (1+ n) pts))ptx))
;下面就是判断线的方向，根据方向，重新排序点
(if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))
(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "y" 0.1)));点排序 HH:ssPts:SortBy 自贡黄明儒
)
(if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))
(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "Y" 0.1)))
)
(if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(< (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "x" 0.1)))
)
(if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(> (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "X" 0.1)))
)
(if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(< (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "xy" 0.1)))
)
(if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(> (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "XY" 0.1)))
)
(if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(< (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "Yx" 0.1)))
)
(if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(> (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "Xy" 0.1)))
)
(command "-layer" "s" "ngc1" "")
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
(mapcar '(lambda (pt)(cons 10 pt)) lst ))
)
(setq n (1+ n))
)
)
和上面的代码一样
希望能得到前辈的指点，上面就是判断线的方向的源代码，根据方向，重新排序点，应该有更加简单的办法，里面函数的出处我都标明了。
(defun ssinters(sss / i num obj1 obj2 j interpts ptlist)
(setqi 0
num (sslength sss)
)
(while (< i (1- num))
(setq obj1 (ssname sss i)
obj1 (vlax-ename->vla-object obj1)
j (1+ i)
)
(while (< j num)
(setq obj2 (ssname sss j)
obj2 (vlax-ename->vla-object obj2)
interpts (vla-intersectwith
obj1
obj2
0
)
interpts (vlax-variant-value interpts)
)
(if (> (vlax-safearray-get-u-bound interpts 1) 0)
(progn
(setqinterpts
(vlax-safearray->list interpts)
)
(while (> (length interpts) 0)
(setq ptlist (cons (list (car interpts)
(cadr interpts)
(caddr interpts)
)
ptlist
)
)
(setq interpts (cdddr interpts))
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
ptlist
)
(defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N);By 自贡黄明儒
;;1 点列表排序
(defun sortpts (PTS FUN xyz FUZZ)
(vl-sort pts
'(lambda (a b)
(if (not (equal (xyz a) (xyz b) fuzz))
(fun (xyz a) (xyz b))
)
)
)
)
;;2 排序先后
(defun sortpts1 (PTS KEY FUZZ)
(setq Key (vl-string->list Key))
(foreach xyz (reverse Key)
(cond ((< xyz 100)
(setq fun >)
(setq xyz (nth (- xyz 88) (list car cadr caddr)))
)
(T
(setq fun <)
(setq xyz (nth (- xyz 120) (list car cadr caddr)))
)
)
(setq Pts (sortpts Pts fun xyz fuzz))
)
)
;;3 本程序主程序
(cond
((= (type ssPts) 'PICKSET)
(repeat (setq n (sslength ssPts))
(if (and (setq e (ssname ssPts (setq n (1- n))))
(setq en (entget e))
)
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
)
)
(mapcar 'last (sortpts1 lst KEY FUZZ))
)
((Listp ssPts)
(cond
((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
((= (type (car ssPts)) 'ENAME)
(foreach e ssPts
(if (setq en (entget e))
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
)
)
(mapcar 'last (sortpts1 lst KEY FUZZ))
)
(T
(cond ((equal key "X") (vl-sort ssPts '>))
((equal key "x") (vl-sort ssPts '<))
)
)
)
)
)
)
;; Clockwise-p-Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented
(defun LM:Clockwise-p ( p1 p2 p3 )
((lambda ( n ) (< (car (trans p2 0 n)) (car (trans p1 0 n)))) (mapcar '- p1 p3))
)
;;164.3 [功能] 多段线端点列表 By 自贡黄明儒
;;示例(HH<img src="static/image/smiley/default/tongue.gif" smilieid="7" border="0" alt="" />tLists (car (entsel)))
(defun HH<img src="static/image/smiley/default/tongue.gif" smilieid="7" border="0" alt="" />tLists (en)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
)
)
;(/ osmode_bak clayer_bak ss ss7 ss2 en pts n);猫老师编辑器变量自动生成
(defun c:tt (/ osmode_bak clayer_bak ss ss7 ss2 p1 pts p2 p3 en n ss1sss ptx lst pt)
;----开始系统变量备份----
(command "undo" "be")
(setvar "cmdecho" 0);_关闭命令提示
(setq osmode_bak (getvar "osmode"));_记录捕捉
(setvar "osmode" 0);_关闭捕捉
(setq clayer_bak (getvar "clayer"));_记录当前图层
;----;----;----;----;----;----;----;----;----
;按照图层分选择集，为了求2个图层对象的交点
(setq ss (ssget))
(command "select" ss"")
(setq ss7 (ssget "p" '((8 . "ngc7"))))
(command "select" ss "")
(setq ss2 (ssget "p" '((8 . "ngc2"))))
(setq en (ssname ss7 0))
(setq pts (HH<img src="static/image/smiley/default/tongue.gif" smilieid="7" border="0" alt="" />tLists en));HH<img src="static/image/smiley/default/tongue.gif" smilieid="7" border="0" alt="" />tLists多段线端点列表 By 自贡黄明儒
(setq n 0)
(if (< (fix(vlax-curve-getEndParam en)) 2)
(progn
(dengg);一条线的时候
)
)
(if (> (fix(vlax-curve-getEndParam en)) 1)
(progn
(deng);多条线的时候
)
)
;----结束系统变量还原----
(setvar "osmode" osmode_bak);_还原捕捉
(setvar "clayer" clayer_bak);_还原图层
(setvar "cmdecho" 1);_打开命令提示
(command "undo" "e")
(princ);_关闭程序返回值
)
;(/ p1 pts p2 p3 en n ss1 ss2 sss ptx lst pt)
(defun deng ()
(setq p1 (nth 0 pts)
p2 (nth 1 pts)
p3 (nth 2 pts)
)
(if (= (LM:Clockwise-p p1 p2 p3) nil); 判断顺时针和逆时针Clockwise-p-Lee Mac
(progn (setq pts(reverse pts)))
)
;重复动作
(repeat
(fix(vlax-curve-getEndParam en))
(command "line" (nth n pts) (nth (1+ n) pts) "")
(setq ss1 (entlast))
(command "select" ss1 ss2 "")
(setq sss (ssget "p" ))
(setq ptx (ssinters sss));ssinters求交点，明经论坛里面的
(command "erase" ss1 "")
(setq lst (append (list(nth n pts) (nth (1+ n) pts))ptx))
;下面就是判断线的方向，根据方向，重新排序点
(if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))
(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "y" 0.1)));点排序 HH:ssPts:SortBy 自贡黄明儒
)
(if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))
(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "Y" 0.1)))
)
(if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(< (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "x" 0.1)))
)
(if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(> (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "X" 0.1)))
)
(if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(< (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "xy" 0.1)))
)
(if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(> (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "XY" 0.1)))
)
(if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(< (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "Yx" 0.1)))
)
(if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
(> (car(nth n pts)) (car(nth (1+ n) pts)))
)
(progn(setq lst (HH:ssPts:Sort lst "Xy" 0.1)))
)
(command "-layer" "s" "ngc1" "")
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
(mapcar '(lambda (pt)(cons 10 pt)) lst ))
)
(setq n (1+ n))
)
)
好东西 流氓兔 发表于 2021-3-25 21:54
(defun ssinters(sss / i num obj1 obj2 j interpts ptlist)
(setqi 0
num (sslength sss)
请问老师，这个是按线顺序排点吗。 我自己做的工具箱，已经发布在论坛的工具篇
春婵建筑模型CAD绘图工具箱
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=176964&fromuid=363233
(出处: 明经CAD社区)
楼主厉害啊， 顶起顶起，，，，期待楼主的更新 非常好的代码，谢谢分享啊。 找了好长时间终于找到了 LIULISHENG 发表于 2021-4-25 17:20
找了好长时间终于找到了
还能有好多的拓展代码 咋没看明白咋回事呢，是只能判断多段线吗
页:
[1]
2