找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1618|回复: 1

[每日一码] API测试 检查悬挂点

[复制链接]

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-28 01:06:03 | 显示全部楼层 |阅读模式

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

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

×
本帖最后由 st788796 于 2013-11-28 12:47 编辑

改编自 eachy 副站长程序,同等替换,未作测试!
  1. (defun c:Chkopen (/ RemoveDups diff box pl)
  2.   (defun RemoveDups (pts fuzz / ll)
  3.     (setq ll (list (car pts)))
  4.     (while (setq pts (cdr pts))
  5.       (setq pts        (vl-remove-if
  6.                   '(lambda (x) (equal (car x) (caar ll) fuzz))
  7.                   pts
  8.                 )
  9.             ll        (cons (car pts) ll)
  10.       )
  11.     )
  12.     ll
  13.   )
  14.   (gc)
  15.   (princ "\n选择Line,Pline,Arc,Spline,Ellipse...")  
  16.   (XD::Doc:DisableOsmode)
  17.   (if (setq ss (ssget '((0 . "*line,arc,ellipse"))))
  18.     (progn
  19.       (princ "\nPlease Waiting, Checking.....")
  20.       (setq diff (/ 1. 64)
  21.             box         (xdrx_entity_box ss)
  22.             pl         (mapcar '(lambda (x)
  23.                             (list (list (xdrx_curve_getstartpoint x) x)
  24.                                   (list (xdrx_curve_getendpoint x) x)
  25.                             )
  26.                           )
  27.                          (vl-remove-if
  28.                            '(lambda (c) (xdrx_curve_isclosed c))
  29.                            (xdrx_pickset->ents ss)
  30.                          )
  31.                  )
  32.       )
  33.       (if (apply 'xdrx_document_isptoutscreen box)
  34.         (xdrx_document_zoomw (car box) (nth 2 box))
  35.       )
  36.       (if (setq pl (RemoveDups pl diff))
  37.         (setq
  38.           pl (vl-remove
  39.                't
  40.                (mapcar
  41.                  '(lambda (x / s sl e p)
  42.                     (setq p (car x)
  43.                           e (cadr x)
  44.                     )
  45.                     (if        (and (setq s
  46.                                     (ssget
  47.                                       ":E"
  48.                                       '((0
  49.                                          .
  50.                                          "line,lwpolyline,polyline,spline,circle,arc,ellipse"
  51.                                         )
  52.                                        )
  53.                                     )
  54.                              )
  55.                              (ssdel e s)
  56.                              (> (sslength s) 0)
  57.                         )
  58.                       (if
  59.                         (> (car
  60.                              (vl-sort
  61.                                (mapcar
  62.                                  '(lambda (x)
  63.                                     (distance
  64.                                       (xdrx_curve_getclosestpoint x p)
  65.                                       p
  66.                                     )
  67.                                   )
  68.                                  (xdrx_pickset->ents s)
  69.                                )
  70.                                '<
  71.                              )
  72.                            )
  73.                            diff
  74.                         )
  75.                          t
  76.                       )
  77.                       p
  78.                     )
  79.                   )
  80.                  pl
  81.                )
  82.              )
  83.         )
  84.         (if (setq pl (vl-remove 'nil pl))
  85.           (progn
  86.             (xdrx_layer_make "XD_mark_open" 1)
  87.             (xdrx_setmark)
  88.             (mapcar '(lambda (x / c)
  89.                        (setq c (xdrx_circle_make x 1.))
  90.                        (xdrx_setpropertyvalue c "layer" "XD_mark_open")
  91.                      )
  92.                     pl
  93.             )
  94.             (xdrx_group_make "*" (xdrx_getss))
  95.             (setvar "PICKSTYLE" 1)
  96.             (sssetfirst nil (ssget "L"))            
  97.           )
  98.           (princ "\n......OK!.....")
  99.         )
  100.       )
  101.     )
  102.   )
  103.   (XD::Doc:EnableOsmode)
  104.   (princ)
  105. )


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

已领礼包: 19个

财富等级: 恭喜发财

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 22:09 , Processed in 0.179749 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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