【Gu_xl】[讨论]根据选择的直线·、圆弧等实体，自动生成有实体围成的所有边界

Gu_xl · 发表于 2010-2-4 22:51:00

本帖最后由 Gu_xl 于 2013-5-14 09:59 编辑

;;;La为图层名
(defun Layer_zdsb (La / sel make_point_list n mn en entype pt1 pt2 pL sel k p1 p2 enlast ensel)
;;;===============================
;;;表操作函数
;;;判断点 p1 是否在点集PL中，是返回T ，不是返回nil，a为精度
;;;例 (IsInPointList '(1.0001 1.001 0) '((1 1 0) (2 1 0)) 0.001),返回T
(defun IsInPointList (p1 PL a)
;(setq n (length PL))
(if (member t (mapcar '(lambda (b) (equal p1 b a)) PL))
t
nil
)
)
;;;取出图元索引i对应的值
(defun dxf (ent i)
(cdr (assoc i (entget ent)))
)
;;;取圆弧的起点、终点。中点
(defun arc_3point (a / cenp radius STP ENPmp arcmidpoint)
(setq cenp (cdr (assoc 10 (entget a))))
(setq radius (cdr (assoc 40 (entget a))))
(setq STP (vlax-curve-getPointAtParam A (vlax-curve-getstartparam A)))
(setq ENP (vlax-curve-getPointAtParam A (vlax-curve-getEndParam A)))
(setq arcmidpoint (polar (polar stp (angle stp enp) (/ (distance STP ENP) 2.0))
(angle cenp (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)))
(- radius (distance (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)) cenp))))
(list stp enp arcmidpoint)
)
;;;根据选择集中的line、arc、circle，生成点集
(defun make_point_list (s / PL)
(setq n 0 PL '() mn (sslength s))
(repeat mn
(setq en (ssname s n)
enType (dxf en 0))
(cond
((= enType "LINE")
(setq pt1 (dxf en 10)
pt2 (dxf en 11))
(if (not (IsInPointList pt1 pl 0.00001))
(setq pl (cons pt1 pl))
);if
(if (not (IsInPointList pt2 pl 0.00001))
(setq pl (cons pt2 pl))
);if
)
((= enType "ARC")
(setq pt1 (car (arc_3point en))
pt2 (cadr (arc_3point en))
)
(if (not (IsInPointList pt1 pl 0.00001))
(setq pl (cons pt1 pl))
);if
(if (not (IsInPointList pt2 pl 0.00001))
(setq pl (cons pt2 pl))
);if
)
);cond
(setq n (1+ n))
);repeat
(setq pl pl)
);make_point_list
;;;此处SEL选择集可自行修改为命令行选择代码
(setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))
(if sel
(progn
(setq Plist (make_point_list sel))
(setq enlast (entlast) ensel (ssadd))
(setvar "CLAYER" la)
(command "_.boundary" "a" "b" "n" sel "" "" )
(setq n -1
mn 0
k (length Plist))
(repeat k
(setq p0 (nth (setq n (1+ n)) Plist) mn n)
(repeat (- k n 1)
(setq p1 (nth (setq mn (1+ mn)) Plist))
(setq p2 (midpoint p0 p1))
(command p2)
);repeat
);repeat
(command "")
(while (setq en (entnext enlast))
(setq enlast en)
(ssadd en ensel)
);while
(command "erase" sel "")
(setq ensel ensel)
);progn
nil
);if
)

;;;La为图层名 
(defun Layer_zdsb (La / sel make_point_list n mn en entype pt1 pt2 pL sel k p1 p2 enlast ensel) 
;;;=============================== 
;;;表操作函数 
;;;判断点 p1 是否在点集PL中，是返回T ，不是返回nil，a为精度 
;;;例 (IsInPointList '(1.0001 1.001 0) '((1 1 0) (2 1 0)) 0.001),返回T 
(defun IsInPointList (p1 PL a) 
;(setq n (length PL)) 
(if (member t (mapcar '(lambda (b) (equal p1 b a)) PL)) 
t 
nil 
) 
) 
;;;取出图元索引i对应的值 
(defun dxf (ent i) 
(cdr (assoc i (entget ent))) 
) 
;;;取圆弧的起点、终点。中点 
(defun arc_3point (a / cenp radius STP ENPmp arcmidpoint) 
(setq cenp (cdr (assoc 10 (entget a)))) 
(setq radius (cdr (assoc 40 (entget a)))) 
(setq STP (vlax-curve-getPointAtParam A (vlax-curve-getstartparam A))) 
(setq ENP (vlax-curve-getPointAtParam A (vlax-curve-getEndParam A))) 
(setq arcmidpoint (polar (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)) 
(angle cenp (polar stp (angle stp enp) (/ (distance STP ENP) 2.0))) 
(- radius (distance (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)) cenp)))) 
(list stp enp arcmidpoint) 
) 
 
 
;;;根据选择集中的line、arc、circle，生成点集 
(defun make_point_list (s / PL) 
(setq n 0 PL '() mn (sslength s)) 
(repeat mn 
(setq en (ssname s n) 
enType (dxf en 0)) 
(cond 
((= enType "LINE") 
(setq pt1 (dxf en 10) 
pt2 (dxf en 11)) 
(if (not (IsInPointList pt1 pl 0.00001)) 
(setq pl (cons pt1 pl)) 
);if 
(if (not (IsInPointList pt2 pl 0.00001)) 
(setq pl (cons pt2 pl)) 
);if 
) 
((= enType "ARC") 
(setq pt1 (car (arc_3point en)) 
pt2 (cadr (arc_3point en)) 
) 
(if (not (IsInPointList pt1 pl 0.00001)) 
(setq pl (cons pt1 pl)) 
);if 
(if (not (IsInPointList pt2 pl 0.00001)) 
(setq pl (cons pt2 pl)) 
);if 
 
) 
 
);cond 
(setq n (1+ n)) 
);repeat 
(setq pl pl) 
);make_point_list 
;;;此处SEL选择集可自行修改为命令行选择代码 
(setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La)))) 
(if sel 
(progn 
(setq Plist (make_point_list sel)) 
(setq enlast (entlast) ensel (ssadd)) 
(setvar "CLAYER" la) 
(command "_.boundary" "a" "b" "n" sel "" "" ) 
(setq n -1 
mn 0 
k (length Plist)) 
(repeat k 
(setq p0 (nth (setq n (1+ n)) Plist) mn n) 
(repeat (- k n 1) 
(setq p1 (nth (setq mn (1+ mn)) Plist)) 
(setq p2 (midpoint p0 p1)) 
(command p2) 
);repeat 
);repeat 
(command "") 
(while (setq en (entnext enlast)) 
(setq enlast en) 
(ssadd en ensel) 
);while 
(command "erase" sel "") 
(setq ensel ensel) 
);progn 
nil 
);if 
)

程序缺点是选择的实体多了，计算速度太慢，请高手讨论，提供共好的算法！
程序加以改进后，完整代码如下：

游客，本帖隐藏的内容需要发帖数高于 10 才可浏览，你当前发帖数只有 0

zhd81617 · 发表于 2012-3-19 12:25:57

谢谢作者

xiaocaiji · 发表于 2024-11-5 16:20:40

Gu_xl 发表于 2010-2-6 18:52
不好意思，该处代码有误，已修改((= enType "ARC")(setq pt1 (car (arc_3point en))pt2 (cadr (arc_3point ...

学习下，谢谢

pickstar · 发表于 2019-1-20 16:39:49

xuexi

liu_kunlun · 发表于 2010-2-5 09:17:00

用手工选择限制选择实体的范围

(setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))

改为：(setq sel (ssget (list '(0 . "line,arc,circle") (cons 8 La))))

yoyoho · 发表于 2010-2-6 09:31:00

Gu_xl 你好:

程序对圆弧是不是有问题啊!

如果仅选择线是O.K.

如果选择含有圆弧时,有错误讯息!

ERROR:损坏的引数类型: lentityp nilosnap
目前的物件锁点模式: 端点,中点,中心点,交点
输入物件锁点模式的清单: endp,mid,int,cen

Gu_xl · 发表于 2010-2-6 18:52:00

Gu_xl 你好:
程序对圆弧是不是有问题啊!
如果仅选择线是O.K.
如果选择含有圆弧时,有错误讯息!
ERROR:损坏的引数类型: lentityp nilosnap
目前的物件锁点模式: 端点,中点,中心点,交点
输入物件锁点模式的清单: endp,mid,int,cen

不好意思，该处代码有误，已修改

((= enType "ARC")
(setq pt1 (car (arc_3point en))
pt2 (cadr (arc_3point en))
)

yoyoho · 发表于 2010-2-6 19:38:00

Gu_xl你好:

依照你的方式修正程序,

程序运行O.K.

感谢你的帮忙!

461045462 · 发表于 2010-12-22 17:58:56

收藏了，下来学习
谢谢楼主的分享

xiaxiang · 发表于 2010-12-22 20:01:05

感谢分享，gu_xl

mandala · 发表于 2011-2-16 13:26:31

这个东西厉害。感谢版主分享。

xhq1954425 · 发表于 2011-2-17 05:08:09

下来备用，谢谢分享！

qcw911 · 发表于 2011-2-17 07:43:31

好程序，下载收藏!

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

[【Gu_xl】] 【Gu_xl】[讨论]根据选择的直线·、圆弧等实体，自动生成有实体围成的所有边界

评分

本帖被以下淘专辑推荐: