设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1390|回复: 98

[每日一码] 多段线PURGE(删除冗余顶点,重叠,共线段)

  [复制链接]

签到天数: 789 天

连续签到: 11 天

[LV.10]以坛为家III

已领礼包: 19个

财富等级: 恭喜发财

发表于 2018-3-17 15:42:51 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

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

x

;; 删除所有多余的顶点(重叠,共线或同心)
;; 保持弧度和宽度
;; 保持显示宽度中断的顶点
;; 封闭起点和终点重叠的pline


clean2.png

XX.JPG

  1. ;; 删除所有多余的顶点(重叠,共线或同心)
  2. ;; 保持弧度和宽度
  3. ;; 保持显示宽度中断的顶点
  4. ;; 封闭起点和终点重叠的pline

  5. (defun purge-pline (pl              /                regular-width            colinear  concentric
  6.                     del-cadr  pour-car        elst          closed    old-p     old-b
  7.                     old-sw    old-ew        new-d          new-p            new-b     new-sw
  8.                     new-ew    b1        b2
  9.                    )

  10.   ;; Evaluates if the pline width is regular on 3 successive points
  11.   (defun regular-width (p1 p2 p3 ws1 we1 ws2 we2 / delta)
  12.     (or        (= ws1 we1 ws2 we2)
  13.         (and (= we1 ws2)
  14.              (/= 0 (setq delta (- we2 ws1)))
  15.              (equal (/ (- (vlax-curve-getDistAtPoint pl (trans p2 pl 0))
  16.                           (vlax-curve-getDistAtPoint pl (trans p1 pl 0))
  17.                        )
  18.                        (- (vlax-curve-getDistAtPoint pl (trans p3 pl 0))
  19.                           (vlax-curve-getDistAtPoint pl (trans p1 pl 0))
  20.                        )
  21.                     )
  22.                     (/ (- we1 (- we2 delta)) delta)
  23.                     1e-9
  24.              )
  25.         )
  26.     )
  27.   )

  28.   ;; Evaluates if 3 successive vertices are aligned
  29.   (defun colinear (p1 p2 p3 b1 b2)
  30.     (and (zerop b1)
  31.          (zerop b2)
  32.          (null (inters p1 p2 p1 p3)
  33.          )
  34.     )
  35.   )
  36.   ;; Removes the second item of the list
  37.   (defun del-cadr (lst)
  38.     (set lst (cons (car (eval lst)) (cddr (eval lst))))
  39.   )

  40.   ;; Pours the first item of a list to another one
  41.   (defun pour-car (from to)
  42.     (set to (cons (car (eval from)) (eval to)))
  43.     (set from (cdr (eval from)))
  44.   )


  45.   (setq elst (entget pl))
  46.   (and (= 1 (logand 1 (cdr (assoc 70 elst)))) (setq closed T))
  47.   (mapcar (function (lambda (x)
  48.                       (cond
  49.                         ((= (car x) 10) (setq old-p (cons x old-p)))
  50.                         ((= (car x) 40) (setq old-sw (cons x old-sw)))
  51.                         ((= (car x) 41) (setq old-ew (cons x old-ew)))
  52.                         ((= (car x) 42) (setq old-b (cons x old-b)))
  53.                         (T (setq new-d (cons x new-d)))
  54.                       )
  55.                     )
  56.           )
  57.           elst
  58.   )
  59.   (mapcar (function (lambda (l)
  60.                       (set l (reverse (eval l)))
  61.                     )
  62.           )
  63.           '(old-p old-sw old-ew old-b new-d)
  64.   )
  65.   (and closed (setq old-p (append old-p (list (car old-p)))))
  66.   (and (equal (cdar old-p) (cdr (last old-p)) 1e-9)
  67.        (setq closed T
  68.              new-d  (subst (cons 70 (Boole 7 (cdr (assoc 70 new-d)) 1))
  69.                            (assoc 70 new-d)
  70.                            new-d
  71.                     )
  72.        )
  73.   )
  74.   (while (cddr old-p)
  75.     (if        (regular-width
  76.           (cdar old-p)
  77.           (cdadr old-p)
  78.           (cdaddr old-p)
  79.           (cdar old-sw)
  80.           (cdar old-ew)
  81.           (cdadr old-sw)
  82.           (cdadr old-ew)
  83.         )
  84.       (cond
  85.         ((colinear (cdar old-p)
  86.                    (cdadr old-p)
  87.                    (cdaddr old-p)
  88.                    (cdar old-b)
  89.                    (cdadr old-b)
  90.          )
  91.          (mapcar 'del-cadr '(old-p old-sw old-ew old-b))
  92.         )
  93.         ((setq bu (concentric
  94.                     (cdar old-p)
  95.                     (cdadr old-p)
  96.                     (cdaddr old-p)
  97.                     (cdar old-b)
  98.                     (cdadr old-b)
  99.                   )
  100.          )
  101.          (setq old-b (cons (cons 42 bu) (cddr old-b)))
  102.          (mapcar 'del-cadr '(old-p old-sw old-ew))
  103.         )
  104.         (T
  105.          (mapcar 'pour-car
  106.                  '(old-p old-sw old-ew old-b)
  107.                  '(new-p new-sw new-ew new-b)
  108.          )
  109.         )
  110.       )
  111.       (mapcar 'pour-car
  112.               '(old-p old-sw old-ew old-b)
  113.               '(new-p new-sw new-ew new-b)
  114.       )
  115.     )
  116.   )
  117.   (if closed
  118.     (setq new-p (reverse (cons (car old-p) new-p)))
  119.     (setq new-p (append (reverse new-p) old-p))
  120.   )
  121.   (mapcar
  122.     (function
  123.       (lambda (new old)
  124.         (set new (append (reverse (eval new)) (eval old)))
  125.       )
  126.     )
  127.     '(new-sw new-ew new-b)
  128.     '(old-sw old-ew old-b)
  129.   )
  130.   (if (and closed
  131.            (regular-width
  132.              (cdr (last new-p))
  133.              (cdar new-p)
  134.              (cdadr new-p)
  135.              (cdr (last new-sw))
  136.              (cdr (last new-ew))
  137.              (cdar new-sw)
  138.              (cdar new-ew)
  139.            )
  140.       )
  141.     (cond
  142.       ((colinear (cdr (last new-p))
  143.                  (cdar new-p)
  144.                  (cdadr new-p)
  145.                  (cdr (last new-b))
  146.                  (cdar new-b)
  147.        )
  148.        (mapcar (function (lambda (l)
  149.                            (set l (cdr (eval l)))
  150.                          )
  151.                )
  152.                '(new-p new-sw new-ew new-b)
  153.        )
  154.       )
  155.       ((setq bu        (concentric
  156.                   (cdr (last new-p))
  157.                   (cdar new-p)
  158.                   (cdadr new-p)
  159.                   (cdr (last new-b))
  160.                   (cdar new-b)
  161.                 )
  162.        )
  163.        (setq new-b (cdr (reverse (cons (cons 42 bu) (cdr (reverse new-b))))))
  164.        (mapcar (function (lambda (l)
  165.                            (set l (cdr (eval l)))
  166.                          )
  167.                )
  168.                '(new-p new-sw new-ew)
  169.        )
  170.       )
  171.     )
  172.   )
  173.   (entmod
  174.     (append new-d
  175.             (apply 'append
  176.                    (apply 'mapcar
  177.                           (cons 'list (list new-p new-sw new-ew new-b))
  178.                    )
  179.             )
  180.     )
  181.   )
  182. )

  183. ;; BulgeData Retourne les données d'un polyarc (angle rayon centre)

  184. (defun BulgeData (bu p1 p2 / ang rad cen)
  185.   (setq        ang (* 2 (atan bu))
  186.         rad (/ (distance p1 p2)
  187.                (* 2 (sin ang))
  188.             )
  189.         cen (polar p1
  190.                    (+ (angle p1 p2) (- (/ pi 2) ang))
  191.                    rad
  192.             )
  193.   )
  194.   (list (* ang 2.0) rad cen)
  195. )

  196. ;; TAN Retourne la tangente de l'angle

  197. (defun tan (ang)
  198.   (/ (sin ang) (cos ang))
  199. )

  200. ;; SPL Calling function

  201. (defun c:spl (/ ss n pl)
  202.   (vl-load-com)
  203.   (or *acad* (setq *acad* (vlax-get-acad-object)))
  204.   (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
  205.   (princ
  206.     "\nSelect les polylines to be treated or <All>: "
  207.   )
  208.   (or
  209.     (setq ss (ssget '((0 . "LWPOLYLINE"))))
  210.     (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  211.   )
  212.   (if
  213.     ss
  214.      (progn
  215.        (vla-StartUndoMark *acdoc*)
  216.        (setq n -1)
  217.        (while (setq pl (ssname ss (setq n (1+ n))))
  218.          (purge-pline pl)
  219.        )
  220.        (princ (strcat "\n\t" (itoa n) " treated polyline(s)."))
  221.        (vla-EndUndoMark *acdoc*)
  222.      )
  223.      (princ "\nNone selected polyline.")
  224.   )
  225.   (princ)
  226. )

  227. (princ
  228.   "\nSimp-Pline loaded, type SPL to launch the function."
  229. )
  230. (princ)



需要的函数:
游客,如果您要查看本帖隐藏内容请回复

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

签到天数: 1494 天

连续签到: 2 天

[LV.10]以坛为家III

已领礼包: 2476个

财富等级: 金玉满堂

发表于 2018-3-17 15:50:40 | 显示全部楼层
感觉之前看过一样的帖子..
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 355 天

连续签到: 141 天

[LV.8]以坛为家I

已领礼包: 846个

财富等级: 财运亨通

发表于 2018-3-17 19:45:19 | 显示全部楼层
谢谢分享!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

签到天数: 1141 天

连续签到: 8 天

[LV.10]以坛为家III

已领礼包: 2225个

财富等级: 金玉满堂

发表于 2018-3-17 22:13:57 | 显示全部楼层
谢谢分享!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

签到天数: 23 天

连续签到: 1 天

[LV.4]偶尔看看III

已领礼包: 1个

财富等级: 恭喜发财

发表于 2018-3-18 09:08:47 来自手机 | 显示全部楼层
谢谢分享!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

签到天数: 1944 天

连续签到: 1 天

[LV.Master]伴坛终老I

已领礼包: 5287个

财富等级: 富甲天下

发表于 2018-3-18 10:19:16 | 显示全部楼层
感谢大师给我们提供了一个非常实用的功能!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 769 天

连续签到: 1 天

[LV.10]以坛为家III

已领礼包: 315个

财富等级: 日进斗金

发表于 2018-3-18 12:45:09 | 显示全部楼层
看看大师作品!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 452 天

连续签到: 7 天

[LV.9]以坛为家II

已领礼包: 810个

财富等级: 财运亨通

发表于 2018-3-18 14:56:08 | 显示全部楼层
感谢大师分享
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 999 天

连续签到: 5 天

[LV.10]以坛为家III

已领礼包: 1872个

财富等级: 堆金积玉

发表于 2018-3-19 08:36:42 | 显示全部楼层
xuexi!!!!!!!!!!!!!!!!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

签到天数: 249 天

连续签到: 4 天

[LV.8]以坛为家I

已领礼包: 325个

财富等级: 日进斗金

发表于 2018-3-19 08:47:12 | 显示全部楼层
厉害呀!!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

签到天数: 258 天

连续签到: 1 天

[LV.8]以坛为家I

已领礼包: 134个

财富等级: 日进斗金

发表于 2018-3-19 08:49:55 | 显示全部楼层
支持一下哦
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 629 天

连续签到: 1 天

[LV.9]以坛为家II

已领礼包: 707个

财富等级: 财运亨通

发表于 2018-3-19 09:40:05 | 显示全部楼层
回复学习,谢谢了!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1988 天

连续签到: 123 天

[LV.Master]伴坛终老I

已领礼包: 5808个

财富等级: 富甲天下

发表于 2018-3-19 09:54:27 | 显示全部楼层
回复学习,谢谢了!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 542 天

连续签到: 2 天

[LV.9]以坛为家II

发表于 2018-3-19 11:32:16 | 显示全部楼层
谢谢分享!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

签到天数: 643 天

连续签到: 192 天

[LV.9]以坛为家II

已领礼包: 1182个

财富等级: 财源广进

发表于 2018-3-19 18:49:04 | 显示全部楼层
谢谢,支持一下。。。。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2018-12-14 13:20 , Processed in 0.221520 second(s), 61 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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