Gu_xl 发表于 2010-2-2 19:09:00

【Gu_xl】[原创]根据选择的直线、圆弧选择集构成的封闭区域自动生成LWpolyline

本帖最后由 Gu_xl 于 2013-6-11 10:45 编辑 <br /><br /> <table height="100%"><tbody><tr><td colSpan="2"><font style="font-size: 10pt;" id="text6" face="宋体,verdana, arial, helvetica">;;;La为图层名<br>(defun Layer_zdsb (La / sel make_point_list n mn en entype pt1 pt2 pL sel k p1 p2 enlast ensel)<br>;;;===============================<br>;;;表操作函数<br>;;;判断点 p1 是否在点集PL中,是返回T ,不是返回nil,a为精度<br>;;;例 (IsInPointList '(1.0001 1.001 0) '((1 1 0) (2 1 0)) 0.001),返回T<br>(defun IsInPointList (p1 PL a)<br>;(setq n (length PL))<br>(if (member t (mapcar '(lambda (b) (equal p1 b a)) PL))<br>t<br>nil<br>)<br>)<br>;;;取出图元索引i对应的值<br>(defun dxf (ent i)<br>(cdr (assoc i (entget ent)))<br>)<br>;;;取圆弧的起点、终点。中点<br>(defun arc_3point (a / cenp radius STP ENPmp arcmidpoint)<br>(setq cenp (cdr (assoc 10 (entget a))))<br>(setq radius (cdr (assoc 40 (entget a))))<br>(setq STP (vlax-curve-getPointAtParam A (vlax-curve-getstartparam A)))<br>(setq ENP (vlax-curve-getPointAtParam A (vlax-curve-getEndParam A)))<br>(setq arcmidpoint (polar (polar stp (angle stp enp) (/ (distance STP ENP) 2.0))<br>(angle cenp (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)))<br>(- radius (distance (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)) cenp))))<br>(list stp enp arcmidpoint)<br>)<br><br><br>;;;根据选择集中的line、arc、circle,生成点集<br>(defun make_point_list (s / PL)<br>(setq n 0 PL '() mn (sslength s))<br>(repeat mn<br>(setq en (ssname s n)<br>enType (dxf en 0))<br>(cond<br>((= enType "LINE")<br>(setq pt1 (dxf en 10)<br>pt2 (dxf en 11))<br>(if (not (IsInPointList pt1 pl 0.00001))<br>(setq pl (cons pt1 pl))<br>);if<br>(if (not (IsInPointList pt2 pl 0.00001))<br>(setq pl (cons pt2 pl))<br>);if<br>)<br><font color="#f70909">((= enType "ARC")<br>(setq pt1 (car (arc_3point en))<br>pt2 (cadr (arc_3point en))<br>)</font><br>(if (not (IsInPointList pt1 pl 0.00001))<br>(setq pl (cons pt1 pl))<br>);if<br>(if (not (IsInPointList pt2 pl 0.00001))<br>(setq pl (cons pt2 pl))<br>);if<br><br>)<br><br>);cond<br>(setq n (1+ n))<br>);repeat<br>(setq pl pl)<br>);make_point_list<br>;;;此处SEL选择集可自行修改为命令行选择代码<br>(setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))<br>(if sel<br>(progn<br>(setq Plist (make_point_list sel))<br>(setq enlast (entlast) ensel (ssadd))<br>(setvar "CLAYER" la)<br>(command "_.boundary" "a" "b" "n" sel "" "" )<br>(setq n -1<br>mn 0<br>k (length Plist))<br>(repeat k<br>(setq p0 (nth (setq n (1+ n)) Plist) mn n)<br>(repeat (- k n 1)<br>(setq p1 (nth (setq mn (1+ mn)) Plist))<br>(setq p2 (midpoint p0 p1))<br>(command p2)<br>);repeat<br>);repeat<br>(command "")<br>(while (setq en (entnext enlast))<br>(setq enlast en)<br>(ssadd en ensel)<br>);while<br>(command "erase" sel "")<br>(setq ensel ensel)<br>);progn<br>nil<br>);if<br>)</font><br>&nbsp;&nbsp;&nbsp;&nbsp;</td></tr><tr><td vAlign="bottom" colSpan="2"><br>红色代码有误,已做修改!!!<br><br></td></tr></tbody></table>

一张单程票 发表于 2021-12-14 13:15:10

是我不懂吗,好多无用语句,说到底就是这个命令的(command "_.boundary" "a" "b" "n" sel "")

864643236 发表于 2017-11-5 17:04:00

感谢楼主,很不错的插件,但为什么只能在俯视图里使用呢,要是能实用所有视图就好了

669423907 发表于 2011-7-14 20:45:28

很高!看不懂!

sunsky 发表于 2011-11-6 00:32:13

;;;此处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))
在VB中如何实现呢?

santalin 发表于 2011-12-13 18:52:47

这个对于圆弧和多段线的处理有问题

mzyshx 发表于 2013-7-14 00:19:18

学习了                                          

comechris 发表于 2013-8-21 20:27:57

谢谢分享
是直接把代码复制到TXT,然后改成LSP,再用CAD加载吗?

KunG-n 发表于 2013-9-23 11:18:16

支持支持支持支持支持支持支持支持支持支持支持支持支持支持支持支持

flyfox1047 发表于 2013-11-9 13:05:56

为什么没有配动图?

bzhjl 发表于 2014-1-2 11:59:02

很高!看不懂!谢谢分享

清风明月名字 发表于 2014-1-2 14:26:00

谢谢楼主的分享!很有意思
页: [1] 2 3 4
查看完整版本: 【Gu_xl】[原创]根据选择的直线、圆弧选择集构成的封闭区域自动生成LWpolyline