[求助]请问如何求出两条多义线的交点？

xuming

谁能告诉我下面程序如何放到CAD程序中去及又如何使用？谢了（QQ:308302994)

 

 

(defun get_all_inters_in_SS (SS /
        SSL ;length of SS
        TS ;returning list
        aObj1 ;Object 1
        aObj2 ;Object 2
        N1  ;Loop counter
        N2  ;Loop counter
        iPts ;intersects
        )
  (setq N1 0 ;index for outer loop
 SSL (sslength SS))
  ; Outer loop, first through second to last
  (while (< N1 (1- SSL))
    ; Get object 1, convert to VLA object type
    (setq aObj1 (ssname SS N1)
   aObj1 (vlax-ename->vla-object aObj1)
   N2 (1+ N1)) ;index for inner loop
    ; Inner loop, go through remaining objects
    (while (< N2 SSL)
      ; Get object 2, convert to VLA object
      (setq aObj2 (ssname SS N2)
     aObj2 (vlax-ename->vla-object aObj2)
     ; Find intersections of Objects
     iPts (vla-intersectwith aObj1
     aObj2 0)
     ; variant result
     iPts (vlax-variant-value iPts))
      ; Variant array has values?
      (if (> (vlax-safearray-get-u-bound iPts 1)
      0)
 (progn ;array holds values, convert it
   (setq iPts ;to a list.
   (vlax-safearray->list iPts))
   ;Loop through list constructing points
   (while (> (length iPts) 0)
     (setq ts (cons (list (car iPts)
      (cadr iPts)
      (caddr iPts))
       ts)
    iPts (cdddr iPts)))))
      (setq N2 (1+ N2))) ;inner loop end
    (setq N1 (1+ N1))) ;outer loop end
  ts) ;return list of points found
;;-----------------------------------------------   END LISTING 1
;;
;; Remaining lines of code for download version, used to demonstrate and test the utility in Listing 1.
;;
;; rocess - Create drawing with intersecting lines and lwpolylines.
;;           Load function set
;;           Run command function INTLINES
;;           Intersections are marked with OINT objects on current layer
;;
(defun C:INTLINES ()
  (prompt "\nINTLINES running to demonstrate GET_ALL_INTERS_IN_SS function.")
  (setq SS1 (get_all_lines_as_SS)
 TS (get_all_inters_in_ss SS1)
        )
  (foreach T TS ;;Loop through list of points
    (command "_POINT" T)) ;;Create point object
  (setvar "PDMODE" 34) ;;display points so you can see them
  (command "_REGEN")
)
;;
;;-----------------------------------------------
;;  Get all lines and lwpolyline objects in the
;;  drawing and return as a selection set.
;;
(defun get_all_Lines_as_SS ()
  (ssget "X" '((0 . "LINE,LWPOLYLINE"))))
;;

zmdjing

不会用啊  说清好吗

TANER

现成的

dispbbs.asp?boardID=3&ID=8719&page=1

发错了位置，请版主删除。

killer9806

精彩，本菜鸟顶一个，各位高手太棒了。

小菜123

都用的 intersectwith方法，有些缺点，一是当一段圆弧极短的时候，会得出错误的交点，还有就是两条线靠得很近，但不相交，但可以求出交点，如果不信，我可以提供一个图试试

knight928

这些交点程序，得到的结果都包含了线的顶点坐标，这样对于任意个多边形的相邻的情况（注意不是相交的）既有几个顶点的边重合的时候，这样得到的坐标不是交点的坐标，而是重合点的坐标！请问如何去除顶点坐标？

zxq651007z

如果只是在屏幕上读交点，那是很容易的，打开捕捉，设定为交点就行了，用得着这么兴师动众？

cb000007

我顶.顶,顶,顶.

sjsapple

;求两实体交点
(defun c:get_int0( / ent1 ent2 ps)
  (setq ent1 (car (entsel "选择第一实体:")))
  (setq ent2 (car (entsel "选择第二实体:")))
  (print)
  (setq ps (obj_int ent1 ent2))
)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;功能:返回两个对象的所有交点
;参数: ent1、ent2 均为ename对象
(defun obj_int (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
   (setq ax_ent_1 (vlax-ename->vla-object ent1)
         ax_ent_2 (vlax-ename->vla-object ent2)
   )
   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
   (setq intpoints (vlax-variant-value intpoints))
   (setq i 0)
   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
     (repeat (/ (+ 1
               (- (vlax-safearray-get-u-bound intpoints 1)
                  (vlax-safearray-get-l-bound intpoints 1)
               )
            )
            3
         )
       (setq points (append points (list (list
         (vlax-safearray-get-element intpoints i)
         (vlax-safearray-get-element intpoints (+ i 1))
         (vlax-safearray-get-element intpoints (+ i 2))
       )))
       )
       (setq i (+ 3 i))
     )
   )
   points
)

killer9806

长见识了，学习中…………