- 积分
- 27993
- 明经币
- 个
- 注册时间
- 2013-1-25
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
![](static/image/common/ico_lz.png)
楼主 |
发表于 2024-6-5 20:41:48
|
显示全部楼层
本帖最后由 尘缘一生 于 2024-6-5 20:45 编辑
深入研究一下,这个问题还是很复杂的,为了支持更多类型
继续写下子
![](source/plugin/imc_colorcode/images/loading.gif) - ;是否是偶数--(一级)---
- ;返回 T 偶数 nil 奇数
- (defun isEven (number)
- (zerop (rem number 2))
- )
- ;;平行线集以最短间距成对分组---(一级)---
- ;ss平行线选择集 line,lwpolyline,polyline,circle,arc,ellipse,spline
- ;返回((nam1 nam2) (nam3 nam4)....)
- ;《三领设计 V3.0》MODIFY 尘缘一生 QQ:15290049
- (defun sl-ssll-ab (ss / nam nam1 ssll n pxlis pa dis elis num lllis)
- (setq num (sslength ss))
- (if (= (isEven num) nil)
- (progn
- (ssdel (setq nam (ssname ss (1- num))) ss)
- (setq elis (list (list nam nam)))
- )
- )
- (setq ssll (ssadd))
- (repeat (setq n (sslength ss))
- (ssadd (ssname ss (setq n (1- n))) ssll)
- )
- (while (> (sslength ss) 0)
- (setq nam (ssname ss 0) lllis nil n -1)
- (ssdel nam ssll)
- (while (setq nam1 (ssname ssll (setq n (1+ n))))
- (setq
- pa (caddr (cur_3point nam))
- dis (* (getvar "DIMLFAC") (car (th-per pa (en2obj nam1))))
- )
- (if (> dis 0.0)
- (setq lllis (cons (list dis nam1) lllis))
- )
- )
- (setq lllis (vl-sort lllis '(lambda (a b) (< (car a) (car b)))))
- (setq nam1 (cadar lllis))
- (setq elis (cons (list nam nam1) elis))
- (ssdel nam ss)
- (ssdel nam1 ss)
- (ssdel nam1 ssll)
- )
- elis
- )
- ;线集按角度分组集---(一级)---
- ;ss线集 line,lwpolyline,polyline
- ;返回 (选择集1 选择集2 ...)
- ;《三领设计 V3.0》MODIFY 尘缘一生 QQ:15290049
- (defun sl-ssll-ssgroup (ss / n nam nam1 ss1 ss2 sslis ang ang1)
- (setq ss1 (ssadd))
- (repeat (setq n (sslength ss))
- (ssadd (ssname ss (setq n (1- n))) ss1)
- )
- (while (> (sslength ss) 0)
- (setq nam (ssname ss 0) ang (e-ang nam nil) ss2 (ssadd) n -1) ;e-ang 三领集成:取角度
- (ssdel nam ss1)
- (ssadd nam ss2)
- (while (setq nam1 (ssname ss1 (setq n (1+ n))))
- (setq ang1 (e-ang nam1 nil))
- (if (equal ang ang1 1e-4)
- (progn
- (ssadd nam1 ss2)
- (ssdel nam1 ss)
- )
- )
- )
- (setq sslis (cons ss2 sslis))
- (ssdel nam ss)
- )
- sslis
- )
- ;线集以最短间距成对分组---(一级)---
- ;ss曲线选择集 line,lwpolyline,polyline,circle,arc,ellipse,spline
- ;返回((nam1 nam2) (nam3 nam4)....)
- ;《三领设计 V3.0》MODIFY 尘缘一生 QQ:15290049
- (defun sl-ssCur-ab (ss / n ss1 ss2 elis nam e)
- (setq n -1 ss1 (ssadd) ss2 (ssadd) elis '())
- (while (setq nam (ssname ss (setq n (1+ n))))
- (if (member (dxf1 nam 0) '("ARC" "CIRCLE" "SPLINE" "ELLIPSE"))
- (ssadd nam ss1)
- (ssadd nam ss2)
- )
- )
- (if (> (sslength ss1) 0) (setq elis (append (sl-ssll-ab ss1) elis)))
- (if (> (sslength ss2) 0)
- (progn
- (setq n -1 ss1 (ssadd) ss (ssadd))
- (while (setq nam (ssname ss2 (setq n (1+ n))))
- (if (= (sl:pts-onLine (getpt (ssadd nam))) nil);不共线之线 getpt 实体取点函数 sl:pts-onLine 点集是否共线函数 t nil
- (ssadd nam ss1)
- (ssadd nam ss)
- )
- )
- (if (> (sslength ss1) 0)
- (progn
- (setq e (entlast))
- (slexpline ss1) ;炸开闭合的,拐角的线 slexpine 三领集成,炸线并宽度等特性不变
- (setq ss (sl:pickset-join ss (last_ent e))) ;并集
- )
- )
- (mapcar '(lambda (e) (setq elis (append (sl-ssll-ab e) elis))) (sl-ssll-ssgroup ss))
- )
- )
- elis
- )
- ;;测试----------------最终结果函数 sl-ssCur-ab
- (defun c:tt (/ elis)
- (setq elis (sl-ssCur-ab (ssget '((0 . "LINE,LWPOLYLINE,POLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE")))))
- (mapcar
- '(lambda (e / l)
- (setq l (append (getpt (ssadd (car e))) (getpt (ssadd (cadr e)))))
- (setq l (graham-scan l))
- (if (or (< (length l) 3) (and (>= (length l) 3) (<= (det (car l) (cadr l) (caddr l)) 0.0)))
- (setq l (reverse l))
- )
- (setq l (car (minarearectangle l)))
- (if l
- (slch:lwpolyline l t nil nil 1 nil)
- )
- )
- elis
- )
- )
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|