本帖最后由 龙吟小调 于 2012-11-11 02:01 编辑
adc 发表于 2012-11-10 12:48 http://bbs.mjtd.com/static/image/common/back.gif
请问是这样吗？
应该就是这样的，gif看的不是很清楚，不过我要的检查的线性，不单就直线（有直线.圆弧.多段等，以圆弧最多）。你能帮我编一个这样的程序吗？谢谢了，如果实在不好搞，能帮我编个圆弧和直线的也行，就我上面发的那图形能检查也行（并在命令栏提示有多少个开口）
adc 发表于 2012-11-10 12:48 static/image/common/back.gif
请问是这样吗？
对是这样 ，我 要 支持 的 是圆弧线就可以了 ，是 圆弧线
论坛里有，仔细找。实在找不到，用这个对付一下。
香田里浪人 发表于 2013-1-30 16:37 static/image/common/back.gif
论坛里有，仔细找。实在找不到，用这个对付一下。
谢谢你的帮助
本帖最后由 gufeng 于 2013-2-2 10:36 编辑
执行命令 TT
;;_标记不闭合处画圆 By ls (2013年2月2日10时30分47秒)
(defun c:tt (/ AT_M:SearchSSByList AT_Pl:GetClose C DIST ENAME ENDPT FILTER FIND I L R RETURN SS STARTPT)
(vl-load-com)
(setq filter (list (cons 0 "*line,ELLIPSE,ARC")));_针对线 椭圆 圆弧
(setq ss (ssget filter));_创建选择集
(setq return '());_返回的点表
(setq dist 0.01);_距离
(setq r 2);_圆的半径 实型
(setq l "Err");_创建的圆所在的图层 字符型
(setq c 3);_圆的颜色(颜色号) 整型
;;_指定距离搜索实体图元
(defun AT_M:SearchSSByList (pt S_Dist tylst / PT_A PT_CL PT_LIST RVAL SS X)
(setq pt_list '())
(setq rVal nil)
(setq pt_cl (list 0 0.25 0.5 0.75 1 1.25 1.5 1.75))
(setq pt_a (mapcar '(lambda (x) (* x pi)) pt_cl))
(foreach n_pt_a pt_a
(setq pt_list (cons (polar pt n_pt_a S_Dist) pt_list))
)
(setqss (ssget "cp" pt_list tylst))
(if (/= ss nil)
(setq rVal ss)
(setq rVal nil)
)
rVal
)
;;_曲线是否闭合
(defun AT_Pl:GetClose (ename / PLIST RETURN)
(setq return nil)
(if (vlax-curve-isClosed ename)
(setq return T)
(progn
(setq plist (list (vlax-curve-getStartPoint ename) (vlax-curve-getEndPoint ename)))
(if (equal (car plist) (last plist))
(setq return T)
(setq return nil)
)
)
)
return
)
(if ss
(progn
(setq i -1)
(command "zoom" "e")
(princ "\n正在处理,请稍等...")
(princ)
(while (setq ename (ssname ss (setq i (1+ i))))
(if (not (AT_Pl:GetClose ename));_忽略本身已闭合的
(progn
(setq startpt (vlax-curve-getStartPoint ename));_起点
(setq endpt (vlax-curve-getEndPoint ename));_终点
(foreach pt (list startpt endpt)
(setq find (AT_M:SearchSSByList pt dist filter))
(if find
(progn
(setq find (ssdel ename find)) ;_删除自身的
(if (= (sslength find) 0)
(setq return (cons pt return))
)
)
(setq return (cons pt return))
)
)
)
)
)
(command "zoom" "p")
)
)
(if return
(progn
(foreach pt return
(entmakex (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "ACDbCircle") (cons 10 pt) (cons 40 r) (cons 8 l) (cons 62 c) '(210 0. 0. 1.)))
)
(princ (strcat "\n共检测到 " (itoa (length return)) " 处.."))
)
)
(princ)
)
gufeng 发表于 2013-2-2 10:34 static/image/common/back.gif
执行命令 TT
谢谢你，试用了一下感觉还不错，能留个联系方式不，谢谢你的帮助
学习一下！近期也开始学LISP了！
香田里浪人 发表于 2013-1-30 16:37 static/image/common/back.gif
论坛里有，仔细找。实在找不到，用这个对付一下。
请问这个现在怎么没办法下载了呢？？
gufeng 发表于 2013-2-2 10:34 static/image/common/back.gif
执行命令 TT
我要下。。谢谢
我要下。。谢谢