;|为了提高程序构建多边形的运行速度，需要对程序的数据结构和计算方法进行优化，下面我逐步详解我程序的思路：1、根据处理后的直线、圆弧选择集生成的图元列表entList，数据结构：(图元名 图元名 ...),建立图元和各图元之间的节点对应关系数据表，数据结构：'((图元名 起点的节点编号 端点的节点编号)...)，表中图元名的排序和表entList的顺序一致，再建立节点和坐标数据对应表，数据结构：'((节点编号 坐标)...),这样方便后面构建拓扑邻接表时，搜索只需要搜索节点编号进行比较，不需要在进行比较端点坐标，这样能大大提高运算速度。|;;;;(gxl-ent->Nodes entList jd)根据弧段图元表建立弧段节点表，参数：图元表 精度值 返回值：图元名--节点编号表 '((图元名 首节点编号 末节点编号)...) 节点--坐标表 '((节点编号 坐标)...)(defun gxl-ent->Nodes (entList jd / ent ent_nodes Nodes n k p1 p2 flag flag1 flag2 bh coord p11 p21 nodes1 sortI1 sortI2)(grtext -2 "整理弧段节点表...")(setq n 1 );(setq t1 (getvar "cdate"))(setq ent_nodes (list (list (car entList) 0 1)))(setq Nodes (list (list 1 (vlax-curve-getendPoint (car entList))) (list 0 (vlax-curve-getStartPoint (car entList)))))(foreach ent (cdr entList)(setq flag1 tflag2 t)(setq p1 (vlax-curve-getStartPoint ent)p2 (vlax-curve-getendPoint ent)k 0);;;===========(while (and (setq node (nth k nodes)) (or flag1 flag2));(foreach node nodes(setq bh (car node)coord (cadr node))(if (equal p1 coord jd) (setq bh1 bh flag1 nil))(if (equal p2 coord jd) (setq bh2 bh flag2 nil))(setq k (1+ k));) ;_ foreach)(if flag1(progn(setq bh1 (setq n (1+ n)))(setq nodes (cons (list bh1 p1) nodes))))(if flag2(progn(setq bh2 (setq n (1+ n)))(setq nodes (cons (list bh2 p2) nodes))));;;============(setq ent_nodes (cons (list ent bh1 bh2) ent_nodes)))(grtext);(GXL-SYS-TIMEOUT t1)(list (reverse ent_nodes) (reverse Nodes)));|2、根据生成的段图元名--节点编号表'((图元名 首节点编号 末节点编号)...)，构建一个二维坐标表，数据结构：'((图元起点的节点编号 图元起点的方向点 图元弧段编号 图元末端点方向点 图元末端点节点编号) ...)其中：图元起点的方向点指图元起点到终点的方向上任一点，如果图元为圆弧，则该方向点为切线方向任一点，图元末端点的方向点指图元末端点到起点的方向上任一点，如果图元为圆弧，则该方向点为切线方向任一点，图元弧段编号为图元在表段图元名--节点编号表中的顺序位置，顺序号从1开始|;;;;(gxl-ent->Coordinates enlst) 根据线段图元名--节点编号表'((图元名 首节点编号 末节点编号)...) 构建二维坐标表;;;返回值： 二维坐标表 '((首端点节点编号 首端点方向点 弧段编号 末端点方向点 末端点节点编号) ...);;;(gxl-ent->Coordinates enLst)(defun gxl-ent->Coordinates (enLst / rtn index a b jd n k )(setq index 0);(setq jd 3)(setq rtn(mapcar '(lambda (x)(list (cadr x) ;_ 首端点节点编号(COND((= "LINE" (GXL-DXF (car x) 0))(list (car (setq a (vlax-curve-getendPoint (car x))))(cadr a)) ;_ list)((= "ARC" (GXL-DXF (car x) 0))(list (car (setq b (polar (setq a (vlax-curve-getStartPoint (car x))) (GXL-GETCURVETANGENT (car x) a) 1))) (cadr b)))((WCMATCH (GXL-DXF (car x) 0) "*POLYLINE")(list (car (setq b (polar (setq a (vlax-curve-getStartPoint (car x))) (GXL-GETCURVETANGENT (car x) a) 1))) (cadr b)))) ;_ COND 首端点方向点;(gxl-dxf x 5) ;_ 图元句柄;x ;_ 图元名(setq index (1+ index)) ;_ 弧段编号，从序号1开始(COND((= "LINE" (GXL-DXF (car x) 0))(list (car (setq a (vlax-curve-getstartPoint (car x))))(cadr a)) ;_ list)((= "ARC" (GXL-DXF (car x) 0))(list (car (setq b (polar (setq a (vlax-curve-getStartPoint (car x))) (GXL-GETCURVETANGENT (car x) a) -1.0))) (cadr b)))((WCMATCH (GXL-DXF (car x) 0) "*POLYLINE")(list (car (setq b (polar (setq a (vlax-curve-getStartPoint (car x))) (GXL-GETCURVETANGENT (car x) a) -1.0))) (cadr b)))) ;_ 末端点方向点(caddr x) ;_ 末端点节点编号) ;_ list) ;_ lambdaenlst) ;_ mapcar)rtn;_ vl-sort);|3、根据二维坐标表 '((首端点节点编号 首端点方向点 弧段编号 末端点方向点 末端点节点编号) ...) ，建立弧段拓扑邻接表,'((弧段序号 (首端点关联表 ...) (末端点关联表 ...))...)，建立弧段拓扑邻接表的方法：若某一弧段N 的首端点与另一弧段相关联, 则在弧段拓扑邻接关系表中标记为N ; 若末端点与另一弧段相关联, 则标记为- N如果拓扑表中有nil,则表明线段端点没有邻接边|;;;;(gxl-Toupu-LineList Coordinates) 根据二维坐标表 '((首端点节点编号 首端点方向点 弧段编号 末端点方向点 末端点节点编号) ...);;;建立弧段拓扑邻接表,'((弧段序号 (首端点关联表 ...) (末端点关联表 ...))...)(defun gxl-Toupu-LineList (Coordinates/ toupulist nnn k pstart pendpl new old t2Coordinates0 Coordinates1flag flag1 index pl to bhxh1 xh2 coord) ;_ Coordinates(if (not *jd*) (setq *jd* 0.00001));;;点表倒置(setq Coordinates1 (mapcar 'reverse Coordinates))(grtext -2 "拓扑邻接表...")(foreach coord Coordinates(setq xh1 (car coord)xh2 (last coord))(setq toupulist(cons(list(setq bh (nth 2 coord))(vl-remove-if'(lambda (x) (or (equal x bh) (equal x (* -1 bh))))(append (mapcar 'cadr (GXL-MASSOC xh1 Coordinates)) (mapcar '(lambda (x) (* -1 (cadr x))) (GXL-MASSOC xh1 Coordinates1))))(vl-remove-if'(lambda (x) (or (equal x bh) (equal x (* -1 bh))))(append (mapcar 'cadr (GXL-MASSOC xh2 Coordinates)) (mapcar '(lambda (x) (* -1 (cadr x))) (GXL-MASSOC xh2 Coordinates1)))))toupulist)))(grtext)(reverse toupulist));|4、检查生成的弧段拓扑邻接表，如果有断头的弧段，将其删除，返回处理后的弧段拓扑邻接表和已经删除的弧段表|;;;;(gxl-check-Toupu-LineList toupulist) 参数：弧段拓扑邻接表(defun gxl-check-Toupu-LineList (toupulist / delnil toupulist1 dellist)(setq toupulist1 toupulist)(defun delnil (toupl / tmp tmp1 dellist1 a b)(setq tmp toupulist1)(foreach a toupl(if (member nil a)(progn;(setq dellist (append dellist (list (abs (car a)))))(setq dellist (append dellist (list (car a))))(setq toupulist1 (vl-remove (assoc (abs(car a)) toupulist1) toupulist1))(setq toupulist1(mapcar'(lambda (b)(list (car b)(vl-remove-if'(lambda (x) (= (abs (car a)) (abs x)))(cadr b)) ;_ vl-remove-if(vl-remove-if'(lambda (x) (= (abs (car a)) (abs x)))(caddr b)) ;_ vl-remove-if) ;_ list) ;_ lambdatoupulist1) ;_ mapcar) ;_ setq)))(if (not (equal tmp toupulist1)) (delnil toupulist1)))(delnil toupulist1)(list toupulist1 dellist));|5、根据建立的弧段拓扑邻接表，按照最小角法则搜索多边形，返回 弧段与多边形拓扑关联表 '((多边形序号 (弧段号 ...))...)一条弧段可作为一个或两个多边形的组成边而存在, 亦即从一条弧段出发最多可以搜索出两个正确的多边形. 如图2 所示, 若从弧段A 1 的一端O 出发,并把它作为起始弧段, 把与A 1 的O 端拓扑关联的其它弧段作为中止弧段, 然后比较并找出与A 1 夹角最小的中止弧段A 2, 并把A 2 作为新的起始弧段, 再从它的另一端点出发重复以上过程继续搜索, 直到回到出发弧段A 1 的另一端为止, 则所有搜索出的弧段就构成了一个多边形. 同样, 从A 1 的O 端开始, 并把它作为中止弧段, 把与它拓扑关联的其它弧段作为起始弧段, 然后比较并找出与该弧段夹角最小的弧段, 并把找出的弧段作为新的中止弧段, 再从新弧段的另一端点出发重复以上搜索过程, 直到回到A 1 的另一端为止, 则所有搜索出的弧段就构成了另一个多边形.这样, 从一条弧段出发可以跟踪出两个多边形, 此方法可称为多边形搜索的最小角法则.多边形的搜索按照最小角法则进行. 从编号为1 的弧段的始端出发, 查找弧段拓扑邻接表中与该端点关联的弧段, 按照最小角法则可以搜索出两个多边形. 依照上述方法, 依次把其它弧段作为开始弧段, 共可找出2N (N 为总弧段数) 个多边形. 搜索过程中, 记录构成多边形的弧段编号(一弧段首端与上一弧段关联用正边号, 否则用负边号) 和弧段数, 即形成多边形与弧段的拓扑关联表.|;;;;(gxl-MakePolyList toupulist Coordinates nodes) 最小角法拓扑多边形,返回多边形数据表;;;参数：;;; toupulist 弧段邻接表 '((弧段序号 (首端点关联表 ...) (末端点关联表 ...))...)，从 1 开始;;; Coordinates 二维坐标表 '((首端点节点编号 首端点方向点 弧段编号 末端点方向点 末端点节点编号) ...) 按顺序从1开始;;; nodes 节点--坐标表 '((节点编号 坐标)...)(defun gxl-MakePolyList (toupulist Coordinates nodes / PolyTouPuList nnn xh pstart pend flag p0 p1a0 a1 a2 B1 B2 polytouputoupu0 next t2 kk ExitNum ExitFlag NodestartNodeEnd node) ;_ toupulist(if (not *jd*) (setq *jd* 0.00001));;;测试时间(setq t2 (getvar "cdate"))(setq nn (length Coordinates)n 0to nn)(GXL-SYS-PROGRESS-INIT "拓扑多边形" to)(repeat nn(setq xh (1+ n)) ;_ 弧段序号;(setq bak xh)(if (assoc xh toupulist);;;如果该边在拓扑邻接表里(progn(GXL-SYS-PROGRESS to -1)(setq Nodestart (car (nth n Coordinates))NodeEnd (last (nth n Coordinates))Pstart (cadr (assoc Nodestart nodes))pEnd (cadr (assoc NodeEnd nodes))flag t) ;_ setq;;;首端点搜索多边形(setq p0 pstartp1 (cadr (nth n Coordinates))a0 (angle p0 p1) ;_ 首端点弧段角度toupu0 (cadr (assoc xh toupulist)) ;_ 首端点弧段拓扑邻接表polytoupu (list (* -1 xh)))(setq ExitNum 0 ;_ 循环次数ExitFlag nil) ;_ 陷入死循环标志;;;移除重合的线(setq toupu0 (vl-remove-if'(lambda (x)(if (> x 0)(equal a0 (angle (cadr (assoc (car (nth (1- x) Coordinates)) nodes)) (cadr (nth (1- x) Coordinates))) *jd*)(equal a0 (angle (cadr (assoc (nth 4 (nth (abs (1+ x)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ x)) Coordinates))) *jd*)))toupu0))(if (not (> (length toupu0) 0)) (setq flag nil ExitFlag t))(while flag;;;toupu0与a0按最小角度排序相邻边(setq toupu0(vl-sort toupu0'(lambda (e1 e2)(if (> e1 0)(setq a1 (angle (cadr (assoc (car (nth (1- e1) Coordinates)) nodes)) (cadr (nth (1- e1) Coordinates))))(setq a1 (angle (cadr (assoc (nth 4 (nth (abs (1+ e1)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ e1)) Coordinates)))))(if (> e2 0)(setq a2 (angle (cadr (assoc (car (nth (1- e2) Coordinates)) nodes)) (cadr (nth (1- e2) Coordinates))))(setq a2 (angle (cadr (assoc (nth 4 (nth (abs (1+ e2)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ e2)) Coordinates)))))(if (>= a0 a1) (setq B1 (- a0 a1)) (setq B1 (+ 2pi (- a0 a1))))(if (>= a0 a2) (setq B2 (- a0 a2)) (setq B2 (+ 2pi (- a0 a2))))(< B1 B2))));;;判断Next边是否已经在polytoupu里了;(if (member next (mapcar 'abs polytoupu)) (setq exitflag t))(setq polytoupu (append polytoupu (list (setq next (car toupu0))))) ;_ next 下一邻接边序号;;;验证next 下一邻接边序号的方位角是否和首端点弧段角度a0重合，如重合，找下一边，未找到，结束组多边形(setq falg1 tkk 1)(while flag1(if (> next 0)(setq a1 (angle (cadr (assoc (car (nth (1- next) Coordinates)) nodes)) (cadr (nth (1- next) Coordinates))))(setq a1 (angle (cadr (assoc (nth 4 (nth (abs (1+ next)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ next)) Coordinates)))))(if (equal a0 a1 0.000001) (setq next (nth kk toupu0))(setq flag1 nil))(if (not next) (setq flag1 nil))(setq kk (1+ kk)));(if next (setq polytoupu (append polytoupu (list (setq next (car toupu0))))))(if next(if (> next 0)(progn(setq p0 (cadr (assoc (setq node (nth 4 (nth (1- next) Coordinates))) nodes))a0 (angle p0 (nth 3 (nth (1- next) Coordinates)))toupu0 (caddr (assoc next toupulist)))(if (equal node nodeEnd) (setq flag nil)))(progn(setq p0 (cadr (assoc (setq node (car (nth (abs (1+ next)) Coordinates))) nodes))a0 (angle p0 (cadr (nth (abs (1+ next)) Coordinates)))toupu0 (cadr (assoc (abs next) toupulist)))(if (equal node nodeEnd) (setq flag nil))))(setq flag nil))(setq ExitNum (1+ ExitNum));;;搜索边界次数超过2000次，程序陷入死循环，退出(if (> ExitNum 2000) (setq flag nil ExitFlag t))(if (and flag (not ExitFlag))(progn;;;移除重合的线(setq toupu0 (vl-remove-if'(lambda (x)(if (> x 0)(equal a0 (angle (cadr (assoc (car (nth (1- x) Coordinates)) nodes)) (cadr (nth (1- x) Coordinates))) *jd*)(equal a0 (angle (cadr (assoc (nth 4 (nth (abs (1+ x)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ x)) Coordinates))) *jd*)))toupu0))(if (not (> (length toupu0) 0)) (setq flag nil ExitFlag t)))));_ while(if ExitFlag(setq ExitFlag nil)(setq PolyTouPuList (append PolyTouPuList (list polytoupu))));;;末端点搜索(setq p0 pendp1 (nth 3 (nth n Coordinates))a0 (angle p0 p1) ;_ 起点角度toupu0 (caddr (assoc xh toupulist))polytoupu (list xh)flag t)(setq ExitNum 0 ;_ 循环次数ExitFlag nil) ;_ 陷入死循环标志;;;移除重合的线(setq toupu0 (vl-remove-if'(lambda (x)(if (> x 0)(equal a0 (angle (cadr (assoc (car (nth (1- x) Coordinates)) nodes)) (cadr (nth (1- x) Coordinates))) *jd*)(equal a0 (angle (cadr (assoc (nth 4 (nth (abs (1+ x)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ x)) Coordinates))) *jd*)))toupu0))(if (not (> (length toupu0) 0)) (setq flag nil ExitFlag t))(while flag;;;计算最小角度相邻边(setq toupu0(vl-sort toupu0'(lambda (e1 e2)(if (> e1 0)(setq a1 (angle (cadr (assoc (car (nth (1- e1) Coordinates)) nodes)) (cadr (nth (1- e1) Coordinates))))(setq a1 (angle (cadr (assoc (nth 4 (nth (abs (1+ e1)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ e1)) Coordinates)))))(if (> e2 0)(setq a2 (angle (cadr (assoc (car (nth (1- e2) Coordinates)) nodes)) (cadr (nth (1- e2) Coordinates))))(setq a2 (angle (cadr (assoc (nth 4 (nth (abs (1+ e2)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ e2)) Coordinates)))))(if (>= a0 a1) (setq B1 (- a0 a1)) (setq B1 (+ 2pi (- a0 a1))))(if (>= a0 a2) (setq B2 (- a0 a2)) (setq B2 (+ 2pi (- a0 a2))))(< B1 B2))));;;判断Next边是否已经在polytoupu里了;(if (member next (mapcar 'abs polytoupu)) (setq exitflag t))(setq polytoupu (append polytoupu (list (setq next (car toupu0))))) ;_ next 下一邻接边序号;;;验证next 下一邻接边序号的方位角是否和首端点弧段角度a0重合，如重合，找下一边，未找到，结束组多边形(setq falg1 tkk 1)(while flag1(if (> next 0)(setq a1 (angle (cadr (assoc (car (nth (1- next) Coordinates)) nodes)) (cadr (nth (1- next) Coordinates))))(setq a1 (angle (cadr (assoc (nth 4 (nth (abs (1+ next)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ next)) Coordinates)))))(if (equal a0 a1 0.000001) (setq next (nth kk toupu0))(setq flag1 nil))(if (not next) (setq flag1 nil))(setq kk (1+ kk)));(if next (setq polytoupu (append polytoupu (list (setq next (car toupu0))))))(if next(if (> next 0)(progn(setq p0 (cadr (assoc (setq node (nth 4 (nth (1- next) Coordinates))) nodes))a0 (angle p0 (nth 3 (nth (1- next) Coordinates)))toupu0 (caddr (assoc next toupulist)))(if (equal node nodestart) (setq flag nil)))(progn(setq p0 (cadr (assoc (setq node (car (nth (abs (1+ next)) Coordinates))) nodes))a0 (angle p0 (cadr (nth (abs (1+ next)) Coordinates)))toupu0 (cadr (assoc (abs next) toupulist)))(if (equal node nodestart) (setq flag nil))))(setq flag nil))(setq ExitNum (1+ ExitNum));;;搜索边界次数超过2000次，程序陷入死循环，退出(if (> ExitNum 2000) (setq flag nil ExitFlag t))(if (and flag (not ExitFlag))(progn;;;移除重合的线(setq toupu0 (vl-remove-if'(lambda (x)(if (> x 0)(equal a0 (angle (cadr (assoc (car (nth (1- x) Coordinates)) nodes)) (cadr (nth (1- x) Coordinates))) *jd*)(equal a0 (angle (cadr (assoc (nth 4 (nth (abs (1+ x)) Coordinates)) nodes)) (nth 3 (nth (abs (1+ x)) Coordinates))) *jd*)))toupu0))(if (not (> (length toupu0) 0)) (setq flag nil ExitFlag t))))) ;_ while(if ExitFlag(setq ExitFlag nil)(setq PolyTouPuList (append PolyTouPuList (list polytoupu))))))(setq n (1+ n)))(GXL-SYS-PROGRESS-DONE);(princ " \n多边形拓扑 ")(GXL-SYS-TIMEOUT t2);;;删除多余多边形(gxl-dumpPolyTouPuList PolyTouPuList));|6、多余多边形的消除由于按照最小角法则搜索出的多边形, 其中部分是重复的(例如“岛”被搜索了两次) , 部分是错误的(例如外围轮廓多边形) , 因此这两种多边形需要去除. 其中重复多边形的去除是从多边形与弧段的拓扑关联表中按照边数相等, 且边号绝对值相等的原则来进行; 而错误多边形的去除则按照下面原则进行: 一个多边形与另一多边形有公共边, 同时它又包含另一多边形的非公共边上一点, 则该多边形是错误多边形.|;;;;(gxl-dumpPolyTouPuList PolyTouPuList) 删除多余多边形，本函数仅消除重复的多边形，;;;外包多边形在实际生成多边形后再予以删除(defun gxl-dumpPolyTouPuList (PolyTouPuList / rtn pl nn n a)(setq pl PolyTouPuListnn (length pl)) ;_ setq;(grtext -2 "\n处理多余多边形...");(princ)(GXL-SYS-PROGRESS-INIT "处理多余多边形" nn);;;测试时间;(setq t2 (getvar "cdate"))(while (setq a (car pl)rtn (cons a rtn)pl (vl-remove-if'(lambda (x)(if (= (length a) (length x))(if (equal (vl-sort (mapcar 'abs x) '<)(vl-sort (mapcar 'abs a) '<)) ;_ equalt) ;_ if) ;_ if) ;_ lambdapl) ;_ vl-remove-if) ;_ setq(GXL-SYS-PROGRESS nn -1)) ;_ while(GXL-SYS-PROGRESS-DONE);(GXL-SYS-TIMEOUT t2)(setq rtn (reverse rtn))(vl-remove-if'(lambda (x) (/= (length x) (length (GXL-LISTDUMPATOM (mapcar 'abs x)))))rtn)) ;_ defun;|7、根据生成的多边形拓扑表绘制多边形;;;(gxl-DrawPolyLine PolyTouPuList ssl Coordinates closed)由弧段与多边形拓扑关联表绘制多边形,参数 多边形拓扑关联表 图元名列表 坐标值列表 是否闭合 返回值：多边形选择集;;;PolyTouPuList 多边形拓扑表;;; ssl 图元名--节点编号表 '((图元名 首节点编号 末节点编号)...);;; nodes 节点--坐标表 '((节点编号 坐标)...)|;(defun gxl-DrawPolyLine (PolyTouPuListssl nodes closed / Polytoupu pts_bulges mn ml mk num p1 p2np1 np2 en en1 rtn coords ngxl-DelOutPolyline La_LineType_Color Lay LineType Color xh1 xh2) ;_ PolyTouPuList;;;(gxl-DelOutPolyline ss) 删除拓扑出poly选择集中外边框,返回删除后的选择集;;;(gxl-DelOutPolyline pss)(defun gxl-DelOutPolyline (ss / ssL ssL1 ent flag en1 rtn)(setq ssL (GXL-SEL-SS->LIST ss)rtn (ssadd)flag t)(setq ssL (vl-sort ssL '(lambda (e1 e2) (> (GXL-GETAREA e1) (GXL-GETAREA e2)))))(while flag(setq ent (car ssL)ssL (cdr ssL)ssL1 '()flag1 nil)(while ssL(setq en1 (car ssL)ssL (cdr ssL)) ;_ setq(if (PolyInLwpolyLine en1 ent)(setq flag1 t)(setq ssL1 (cons en1 ssL1))) ;_ if) ;_ while(if flag1 (progn (ssdel ent ss)(entdel ent)(setq flag1 nil)))(if ssL1(setq ssL (vl-sort ssL1 '(lambda (e1 e2) (> (GXL-GETAREA e1) (GXL-GETAREA e2)))))(setq flag nil))) ;_ whiless)(setq rtn (ssadd))(if (not *jd*) (setq *jd* 0.0001))(foreach Polytoupu PolyTouPuList(setq pts nil_bulges nilmn (length Polytoupu)mk 0);(if closed (setq mk 0) (setq mk -1))(foreach num Polytoupu(setq mk (1+ mk))(setq en (car (nth (1- (abs num)) ssl))xh1 (cadr (nth (1- (abs num)) ssl))xh2 (caddr (nth (1- (abs num)) ssl));coords (nth (1- (abs num)) Coordinates)entype (gxl-dxf en 0))(if (> num 0)(setq p1 (cadr (assoc xh1 nodes))p2 (cadr (assoc xh2 nodes))) ;_ setq(setq p1 (cadr (assoc xh2 nodes))p2 (cadr (assoc xh1 nodes))) ;_ setq) ;_ if(cond ((= entype "LINE")(if pts(setq pts (append pts (list p2))_bulges (append _bulges (list 0)))(setq pts (append pts (list p1 p2))_bulges (append _bulges (list 0)))) ;_ if)((= entype "ARC")(if pts(setq pts (append pts (list p2))_bulges (append _bulges (list (cond ((> num 0) (gxl-GetArcBulge en)) (t (* -1.0 (gxl-GetArcBulge en)))))))(setq pts (append pts (list p1 p2))_bulges (append _bulges (list (cond ((> num 0) (gxl-GetArcBulge en)) (t (* -1.0 (gxl-GetArcBulge en)))))))))((= entype "LWPOLYLINE")(setq data (gxl-get_poly_data en))(if (> num 0)(progn(if pts(progn(setq pts (append pts (cdar data)))(setq _bulges (append _bulges (reverse (cdr (reverse (cadr data)))))))(progn(setq pts (append pts (cons p1 (cdar data))))(setq _bulges (append _bulges (cadr data)))))) ;_ progn(progn(GXL-REVERSELWPOLYLINE en)(setq data (gxl-get_poly_data en))(if pts(progn(setq pts (append pts (cdar data)))(setq _bulges (append _bulges (reverse (cdr (reverse (cadr data)))))))(progn(setq pts (append pts (cons p1 (cdar data))))(setq _bulges (append _bulges (cadr data)))))(GXL-REVERSELWPOLYLINE en)) ;_ progn) ;_ if)));(if (= entype "LWPOLYLINE") (setq _bulges (append _bulges (list (last (cadr data))))) (setq _bulges (append _bulges (list 0))))(if closed(vla-put-closed (GXL-AX:ADDLWPOLYLINE1 *MODEL-SPACE* (list pts _bulges )) :vlax-true)(GXL-AX:ADDLWPOLYLINE1 *MODEL-SPACE* (list pts _bulges)))(setq app ptsbus _bulges)(ssadd (setq en (entlast)) rtn);;;修改多段线图层(setq La_LineType_Color (gxl-GetToupuPolyLayer_Linetype_color Polytoupu (mapcar 'car ssl)))(setq lay (car La_LineType_Color)LineType (cadr La_LineType_Color)Color (caddr La_LineType_Color))(gxl-CH_Ent en 8 lay)(if LineType (gxl-CH_Ent en 6 LineType))(if color (gxl-CH_Ent en 62 color))(gxl-DumpPolyPoint en);(vla-put-closed (GXL-AX:ADDLWPOLYLINE *MODEL-SPACE* pts) :vlax-true))(if closed (gxl-DelOutPolyline rtn) rtn) ;_ 返回删除外框后的选择集);;;测试(defun c:mkpoly ()(SETUNDOERR)(if (not *jd*) (setq *jd* 0.00001))(princ "\n基于方位角计算的拓扑多边形自动构建快速算法测试")(princ "\n****程序作者：Gu_xl 2010年8月****")(princ "\n选择直线、圆弧、圆：")(setq ss (ssget '((0 . "line,arc,circle"))))(gxl-makepoly ss)(reerr));;;至此，基于方位角计算的拓扑多边形自动构建快速算法 的主要算法思路的函数功能全部完成，;;;附件是打包的测试程序，调用命令：mkpoly
若有收获，就点个赞吧
0 人点赞
