[编程申请]：XYP和狂刀先生请进；求一条多段线与多条多段线的交点坐标

真龙天子

一种情况是：（见图一）一条红色多义线起点在A处，终点在B处，且A、B点坐标已知，它与n条白色多义线同在同一平面内（二维平面、Z值相同），红线与各白线都有实际的交点Pn，要求按顺序自左向右依次求出p1至pn点的交点坐标。
第二种情况是：（见图二）一条红色多义线起点在A处，终点在B处，在视觉上它与n条白色多义线相交于Pn'（没有实际的交点），白色多义线的z 值各不相同（三维空间）。要求按顺序自左向右依次求出p1至pn点的交点坐标。
    如果能把上述两种情况整合在一个lisp里最好，分做两个lisp也行。

狂刀

求交的例子很多，你搜索先看看，体会一下
第二个问题，可先将曲线压平到ab所在平面，求交点

xyp1964

2. [FONT=courier new]
   
3. ;;;一条线与多条线的交点
   
4. (defun c:test (/ etype ptn)
   
5.   (princ "\n选择源线 : ")
   
6.   (while (not (setq ss1 (ssget '((0 . "CIRCLE,ELLIPSE,*LINE,ARC")))))
   
7.   )
   
8.   (setq s0 (ssname ss1 0))
   
9.   (princ "\n选择目标线 : ")
   
10.   (setq        ss (ssget '((0 . "CIRCLE,ELLIPSE,*LINE,ARC")))
    
11.         i  -1
    
12.   )
    
13.   (command "select" ss "r" s0 "")
    
14.   (setq ss (ssget "P"))
    
15.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
16.     (if        (setq ptlst (xyp-get-Inters s0 s1 0))
    
17.       (setq ptn (append ptn ptlst))
    
18.     )
    
19.   )
    
20.   (if ptn
    
21.     (setq
    
22.       ptn (vl-sort ptn
    
23.                    (function (lambda (e1 e2) (< (car e1) (car e2))))
    
24.           )
    
25.     )
    
26.   )
    
27.   ptn
    
28. )[/FONT]

[FONT=courier new]<br /> ;;;一条线与多条线的交点<br /> (defun c:test (/ etype ptn)<br />   (princ "\n选择源线 : ")<br />   (while (not (setq ss1 (ssget '((0 . "CIRCLE,ELLIPSE,*LINE,ARC")))))<br />   )<br />   (setq s0 (ssname ss1 0))<br />   (princ "\n选择目标线 : ")<br />   (setq        ss (ssget '((0 . "CIRCLE,ELLIPSE,*LINE,ARC")))<br />         i  -1<br />   )<br />   (command "select" ss "r" s0 "")<br />   (setq ss (ssget "P"))<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (if        (setq ptlst (xyp-get-Inters s0 s1 0))<br />       (setq ptn (append ptn ptlst))<br />     )<br />   )<br />   (if ptn<br />     (setq<br />       ptn (vl-sort ptn<br />                    (function (lambda (e1 e2) (< (car e1) (car e2))))<br />           )<br />     )<br />   )<br />   ptn<br /> )[/FONT]

有点小烦

是不是LSP加载啊，怎么启动命令啊！我加载了不知道怎么用！

wmz_0211

想出一个办法,不知可行否?贴出来请大家指教!
;; 曲线求交
;;假定那多条线段位于"DGX"层
(defun c:mint(/ ent1 ent2 m E E1 E2 p plist h)
  (setq ENT1 (car (entsel "\n选择第一根线: ")))
  (setq ent2 (ssget "X" '((8 . "DGX")(0 . "*POLYLINE"))))
  (setq m -1 plist '() p nil)
  (repeat (sslength ent2)
    (setq E2 (ssname ent2 (setq m (1+ m))))
    (setq E (entget E2) E1 (cdr(assoc 0 E)))
    (setq h (cond ((= E1 "POLYLINE")(last (assoc 10 E)))
                  ((= E1 "LWPOLYLINE")(cdr (assoc 38 E)))
            )
    )
    (m_h E2 (- 0 h))
    (setq p0 (x@_int ent1 E2))
    (setq p (list (car p0)(cadr p0) h))
    (setq plist (append plist (list p)))
    (m_h E2 h)
)   
  ;;交点表
  (print plist)
  (princ)
)
(defun x@_int (e1 e2)
  (vlax-invoke (vlax-ename->vla-object e1)
    'IntersectWith (vlax-ename->vla-object e2) 0)
)
(defun m_h (s h)
   (command "_.move" s "" (list 0 0 0) "")
   (command "_.move" s "" (list 0 0 h) "")
)