<P>谁能告诉我下面程序如何放到CAD程序中去及又如何使用？谢了（QQ:308302994)</P>
<P> </P>
<P> </P>
<P>(defun get_all_inters_in_SS (SS /<BR> SSL ;length of SS<BR> PTS ;returning list<BR> aObj1 ;Object 1<BR> aObj2 ;Object 2<BR> N1 ;Loop counter<BR> N2 ;Loop counter<BR> iPts ;intersects<BR> )<BR> (setq N1 0 ;index for outer loop<BR> SSL (sslength SS))<BR> ; Outer loop, first through second to last<BR> (while (< N1 (1- SSL))<BR> ; Get object 1, convert to VLA object type<BR> (setq aObj1 (ssname SS N1)<BR> aObj1 (vlax-ename->vla-object aObj1)<BR> N2 (1+ N1)) ;index for inner loop<BR> ; Inner loop, go through remaining objects<BR> (while (< N2 SSL)<BR> ; Get object 2, convert to VLA object<BR> (setq aObj2 (ssname SS N2)<BR> aObj2 (vlax-ename->vla-object aObj2)<BR> ; Find intersections of Objects<BR> iPts (vla-intersectwith aObj1<BR> aObj2 0)<BR> ; variant result<BR> iPts (vlax-variant-value iPts))<BR> ; Variant array has values?<BR> (if (> (vlax-safearray-get-u-bound iPts 1)<BR> 0)<BR> (progn ;array holds values, convert it<BR> (setq iPts ;to a list.<BR> (vlax-safearray->list iPts))<BR> ;Loop through list constructing points<BR> (while (> (length iPts) 0)<BR> (setq Pts (cons (list (car iPts)<BR> (cadr iPts)<BR> (caddr iPts))<BR> Pts)<BR> iPts (cdddr iPts)))))<BR> (setq N2 (1+ N2))) ;inner loop end<BR> (setq N1 (1+ N1))) ;outer loop end<BR> Pts) ;return list of points found<BR>;;----------------------------------------------- END LISTING 1<BR>;;<BR>;; Remaining lines of code for download version, used to demonstrate and test the utility in Listing 1.<BR>;;<BR>;; Process - Create drawing with intersecting lines and lwpolylines.<BR>;; Load function set<BR>;; Run command function INTLINES<BR>;; Intersections are marked with POINT objects on current layer<BR>;;<BR>(defun C:INTLINES ()<BR> (prompt "\nINTLINES running to demonstrate GET_ALL_INTERS_IN_SS function.")<BR> (setq SS1 (get_all_lines_as_SS)<BR> PTS (get_all_inters_in_ss SS1)<BR> )<BR> (foreach PT PTS ;;Loop through list of points<BR> (command "_POINT" PT)) ;;Create point object<BR> (setvar "PDMODE" 34) ;;display points so you can see them<BR> (command "_REGEN")<BR>)<BR>;;<BR>;;-----------------------------------------------<BR>;; Get all lines and lwpolyline objects in the<BR>;; drawing and return as a selection set.<BR>;;<BR>(defun get_all_Lines_as_SS ()<BR> (ssget "X" '((0 . "LINE,LWPOLYLINE"))))<BR>;;</P>
<P>不会用啊 说清好吗</P>
<P>现成的</P>
<P><A href="dispbbs.asp?boardID=3&ID=8719&page=1" target="_blank" >dispbbs.asp?boardID=3&ID=8719&page=1</A></P>
<P>发错了位置，请版主删除。</P>
<P>精彩，本菜鸟顶一个，各位高手太棒了。</P>
都用的 intersectwith方法，有些缺点，一是当一段圆弧极短的时候，会得出错误的交点，还有就是两条线靠得很近，但不相交，但可以求出交点，如果不信，我可以提供一个图试试
这些交点程序，得到的结果都包含了线的顶点坐标，这样对于任意个多边形的相邻的情况（注意不是相交的）既有几个顶点的边重合的时候，这样得到的坐标不是交点的坐标，而是重合点的坐标！请问如何去除顶点坐标？
如果只是在屏幕上读交点，那是很容易的，打开捕捉，设定为交点就行了，用得着这么兴师动众？
<P>我顶.顶,顶,顶.</P>
;求两实体交点<BR>(defun c:get_int0( / ent1 ent2 ps)<BR> (setq ent1 (car (entsel "选择第一实体:")))<BR> (setq ent2 (car (entsel "选择第二实体:")))<BR> (print)<BR> (setq ps (obj_int ent1 ent2))<BR>)<BR>;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<BR>;功能:返回两个对象的所有交点<BR>;参数: ent1、ent2 均为ename对象<BR>(defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)<BR> (setq ax_ent_1 (vlax-ename->vla-object ent1)<BR> ax_ent_2 (vlax-ename->vla-object ent2)<BR> )<BR> (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))<BR> (setq intpoints (vlax-variant-value intpoints))<BR> (setq i 0)<BR> (if (> (vlax-safearray-get-u-bound intpoints 1) 0)<BR> (repeat (/ (+ 1<BR> (- (vlax-safearray-get-u-bound intpoints 1)<BR> (vlax-safearray-get-l-bound intpoints 1)<BR> )<BR> )<BR> 3<BR> )<BR> (setq points (append points (list (list<BR> (vlax-safearray-get-element intpoints i)<BR> (vlax-safearray-get-element intpoints (+ i 1))<BR> (vlax-safearray-get-element intpoints (+ i 2))<BR> )))<BR> )<BR> (setq i (+ 3 i))<BR> )<BR> )<BR> points<BR>)<BR>
<P>长见识了，学习中…………</P>