;;线，弧首尾不相接的地方做标记

/db_自贡黄明儒_ · 发表于 2014-4-30 13:20:53

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

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

×

;;线，弧首尾不相接的地方做标记
(defun C:w1 (/ E LST LST1 N PTS SS X)
  (cond
((setq ss (ssget ":S" '((0 . "*LINE,ARC"))))
   (repeat (setq n (sslength ss))
   (setq e (ssname ss (setq n (1- n))))
   (setq pts (cons (vlax-curve-getStartPoint e) pts))
   (setq pts (cons (vlax-curve-getEndPoint e) pts))
   )
   (while (setq x (car pts))
   (setq pts (cdr pts))
   (setq lst1 nil
      lst  nil
   )
   (foreach Y pts
   (cond ((equal x Y 0.1) (setq lst (cons Y lst)))
         (T (setq lst1 (cons Y lst1)))
   )
   )
   (cond ((not lst) (command "_.circle" x 5)))
   (setq pts lst1)
   )
)
  )
)

ysq101 · 发表于 2014-4-30 15:17:41

这个叫断点检查..很实用
容差是不是太大了??

/db_自贡黄明儒_ · 发表于 2014-4-30 15:37:55

ysq101 发表于 2014-4-30 15:17
这个叫断点检查..很实用
容差是不是太大了??

大点好呀，这样烂图也能通过。{:soso_e112:}

ysq101 · 发表于 2014-4-30 18:21:34

本帖最后由 ysq101 于 2014-4-30 18:29 编辑

弱弱地问2句： (cond ((equal x Y 0.1) (setq lst (cons Y lst)))
这行是容差值吗？？还有*LINE 还能包括样条线？？？

ysq101 · 发表于 2014-4-30 18:53:33

刚测试了。。。很给力
请黄大师修复一下小BUG
1，UCS下不能用，，需要将点表转到世界座标系
2，用entmkae 来创建红色圆
3，运行后夹选圆方便用户删除
至于容差自己按要求修改

要求越来越高了哦，，，实用不行还是我自己动改改算了

xtdwynij · 发表于 2014-5-2 17:57:32

这个不错！收了！

lucas3 · 发表于 2014-5-3 16:44:26

(defun c:w1 (/ s n e )
(if (setq s (ssget "_:S" '((0 . "*LINE,ARC"))))
(repeat (setq n (sslength s))
(setq e (ssname s (setq n (1- n))))
(foreach p (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
(entmake (list '(0 . "CIRCLE") (cons 10 p) (cons 40 4.) '(62 . 1)))
))
)
(princ)
)

xtdwynij · 发表于 2014-5-12 08:44:03

lucas3 发表于 2014-5-3 16:44

哥你这个是交点画圆吧？这个是不相接也就是不连在一起的时候就画个小圆

xtdwynij · 发表于 2014-5-12 08:45:14

lucas3 发表于 2014-5-3 16:44

黄老师写的根本就不是在端点和起点画圆

lucas3 · 发表于 2014-5-13 15:55:02

本帖最后由 lucas3 于 2014-5-13 18:15 编辑

椭圆弧的检测

((setq ss (ssget ":S" '((0 . "*LINE,ARC,ellipse"))))

14702470 · 发表于 2014-9-3 07:35:02

太好了，找了好久了

账号		自动登录	找回密码
密码			立即注册

[研讨] ;;线，弧首尾不相接的地方做标记

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

点评

点评

评分

点评