明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 598|回复: 11

[函数] 线集按最近距离成对分组(函数)

  [复制链接]
发表于 2024-6-5 06:11 | 显示全部楼层 |阅读模式
本帖最后由 尘缘一生 于 2024-6-5 09:29 编辑

没有找到这个功能,自己写了个。



应用实例:



可以在三领测试效果


链接:https://pan.baidu.com/s/1Jg0m0RLgUdvCrnfe_rQZkw
提取码:eyyo


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1明经币 +1 收起 理由
tranque + 1 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2024-6-5 20:41 | 显示全部楼层
本帖最后由 尘缘一生 于 2024-6-5 20:45 编辑

深入研究一下,这个问题还是很复杂的,为了支持更多类型

继续写下子
  1. ;是否是偶数--(一级)---
  2. ;返回 T 偶数 nil 奇数
  3. (defun isEven (number)
  4.   (zerop (rem number 2))
  5. )
  6. ;;平行线集以最短间距成对分组---(一级)---
  7. ;ss平行线选择集 line,lwpolyline,polyline,circle,arc,ellipse,spline
  8. ;返回((nam1 nam2) (nam3 nam4)....)
  9. ;《三领设计 V3.0》MODIFY 尘缘一生  QQ:15290049
  10. (defun sl-ssll-ab (ss / nam nam1 ssll n pxlis pa dis elis num lllis)
  11.   (setq num (sslength ss))
  12.   (if (= (isEven num) nil)
  13.     (progn
  14.       (ssdel (setq nam (ssname ss (1- num))) ss)
  15.       (setq elis (list (list nam nam)))
  16.     )
  17.   )
  18.   (setq ssll (ssadd))
  19.   (repeat (setq n (sslength ss))
  20.     (ssadd (ssname ss (setq n (1- n))) ssll)
  21.   )
  22.   (while (> (sslength ss) 0)
  23.     (setq nam (ssname ss 0) lllis nil n -1)
  24.     (ssdel nam ssll)
  25.     (while (setq nam1 (ssname ssll (setq n (1+ n))))
  26.       (setq
  27.         pa (caddr (cur_3point nam))
  28.         dis (* (getvar "DIMLFAC") (car (th-per pa (en2obj nam1))))
  29.       )
  30.       (if (> dis 0.0)
  31.         (setq lllis (cons (list dis nam1) lllis))
  32.       )
  33.     )
  34.     (setq lllis (vl-sort lllis '(lambda (a b) (< (car a) (car b)))))
  35.     (setq nam1 (cadar lllis))
  36.     (setq elis (cons (list nam nam1) elis))
  37.     (ssdel nam ss)
  38.     (ssdel nam1 ss)
  39.     (ssdel nam1 ssll)
  40.   )
  41.   elis
  42. )
  43. ;线集按角度分组集---(一级)---
  44. ;ss线集 line,lwpolyline,polyline
  45. ;返回 (选择集1  选择集2 ...)
  46. ;《三领设计 V3.0》MODIFY 尘缘一生  QQ:15290049
  47. (defun sl-ssll-ssgroup (ss / n nam nam1 ss1 ss2 sslis ang ang1)
  48.   (setq ss1 (ssadd))
  49.   (repeat (setq n (sslength ss))
  50.     (ssadd (ssname ss (setq n (1- n))) ss1)
  51.   )
  52.   (while (> (sslength ss) 0)
  53.     (setq nam (ssname ss 0) ang (e-ang nam nil) ss2 (ssadd) n -1) ;e-ang 三领集成:取角度
  54.     (ssdel nam ss1)
  55.     (ssadd nam ss2)
  56.     (while (setq nam1 (ssname ss1 (setq n (1+ n))))
  57.       (setq ang1 (e-ang nam1 nil))
  58.       (if (equal ang ang1 1e-4)
  59.         (progn
  60.           (ssadd nam1 ss2)
  61.           (ssdel nam1 ss)
  62.         )
  63.       )
  64.     )
  65.     (setq sslis (cons ss2 sslis))
  66.     (ssdel nam ss)
  67.   )
  68.   sslis
  69. )
  70. ;线集以最短间距成对分组---(一级)---
  71. ;ss曲线选择集 line,lwpolyline,polyline,circle,arc,ellipse,spline
  72. ;返回((nam1 nam2) (nam3 nam4)....)
  73. ;《三领设计 V3.0》MODIFY 尘缘一生  QQ:15290049
  74. (defun sl-ssCur-ab (ss / n ss1 ss2 elis nam e)
  75.   (setq n -1 ss1 (ssadd) ss2 (ssadd) elis '())
  76.   (while (setq nam (ssname ss (setq n (1+ n))))
  77.     (if (member (dxf1 nam 0) '("ARC" "CIRCLE" "SPLINE" "ELLIPSE"))
  78.       (ssadd nam ss1)
  79.       (ssadd nam ss2)
  80.     )
  81.   )
  82.   (if (> (sslength ss1) 0) (setq elis (append (sl-ssll-ab ss1) elis)))
  83.   (if (> (sslength ss2) 0)
  84.     (progn
  85.       (setq n -1 ss1 (ssadd) ss (ssadd))
  86.       (while (setq nam (ssname ss2 (setq n (1+ n))))
  87.         (if (= (sl:pts-onLine (getpt (ssadd nam))) nil);不共线之线 getpt 实体取点函数  sl:pts-onLine 点集是否共线函数 t nil
  88.           (ssadd nam ss1)
  89.           (ssadd nam ss)
  90.         )
  91.       )
  92.       (if (> (sslength ss1) 0)
  93.         (progn
  94.           (setq e (entlast))
  95.           (slexpline ss1) ;炸开闭合的,拐角的线 slexpine 三领集成,炸线并宽度等特性不变
  96.           (setq ss (sl:pickset-join ss (last_ent e))) ;并集
  97.         )
  98.       )
  99.       (mapcar '(lambda (e) (setq elis (append (sl-ssll-ab e) elis))) (sl-ssll-ssgroup ss))
  100.     )
  101.   )
  102.   elis
  103. )
  104. ;;测试----------------最终结果函数 sl-ssCur-ab
  105. (defun c:tt (/ elis)
  106.   (setq elis (sl-ssCur-ab (ssget '((0 . "LINE,LWPOLYLINE,POLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE")))))
  107.   (mapcar
  108.     '(lambda (e / l)
  109.        (setq l (append (getpt (ssadd (car e))) (getpt (ssadd (cadr e)))))
  110.        (setq l (graham-scan l))
  111.        (if (or (< (length l) 3) (and (>= (length l) 3) (<= (det (car l) (cadr l) (caddr l)) 0.0)))
  112.          (setq l (reverse l))
  113.        )
  114.        (setq l (car (minarearectangle l)))
  115.        (if l
  116.          (slch:lwpolyline l t nil nil 1 nil)
  117.        )
  118.      )
  119.     elis
  120.   )
  121. )




本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

似乎缺少getpt函数  发表于 2024-6-6 19:10
回复 支持 1 反对 0

使用道具 举报

发表于 2024-6-5 07:43 | 显示全部楼层
"graham-scan"是什么函数?
 楼主| 发表于 2024-6-5 07:45 | 显示全部楼层
本帖最后由 尘缘一生 于 2024-6-5 09:10 编辑
bai2000 发表于 2024-6-5 07:43
"graham-scan"是什么函数?

本坛的,高飞鸟大师的扫描求凸包。
发表于 2024-6-5 08:38 | 显示全部楼层
本帖最后由 xj6019 于 2024-6-5 08:45 编辑
尘缘一生 发表于 2024-6-5 07:45
本坛的,高飞大师的扫描求凸包。

测试有遗漏
测试代码如下

(defun c:NM (/ )
        (setq elis (sl-ssll-ab (ssget '((0 . "LINE,LWPOLYLINE,POLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE")))))
        (mapcar
                '(lambda (es / l)
                         (if(<(distance(Midpoint(car es))(Midpoint(cadr es)))300) ;过滤两线中点距离小于300的,否则感觉跟乱
                                 (progn
                                         (setq pt(mid(Midpoint(car es))(Midpoint(cadr es)))) ;求两线中点的中点
                                         (xj-yuan pt 200) ;找出来的位置画圆检查
                                 )
                         )                         
                 )
                elis
        )
)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2024-6-5 08:56 | 显示全部楼层
本帖最后由 尘缘一生 于 2024-6-5 09:01 编辑
xj6019 发表于 2024-6-5 08:38
测试有遗漏
测试代码如下

嗯,我测试用高飞的,主要是检查倾斜角度的支持,


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2024-6-5 09:42 | 显示全部楼层
感谢尘缘前辈的分享
发表于 2024-6-18 21:09 | 显示全部楼层
这是个实用的函数。
发表于 2024-6-19 10:37 | 显示全部楼层
很需要这个函数,感谢
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-6-22 20:17 , Processed in 0.178425 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表