[求助]求空间两曲线交点

mkhsj928

搜索了好几天，没找到求空间两曲线交点的lisp程序呢！

哪位大侠提供一个?

skg123

在地形图上截断面lisp
来源： http://www.znch.net/showcourse.asp?id=61
;;功能：在地形图上截断面
;;命令：dm
;;说明：
(vl-load-com)
(defun C:DM (/ M_OBJ1 M_ENT1 M_ENT2 M_JDTAB100)
    (princ "\n请选择地形线:  ")
    (setq
NUMBER
    (getint
        " 0=样条曲线; 1=多段线；2=样条曲线和多段线<默认0>:"
    )
    )
    (cond
((= NUMBER 0) (setq SS (ssget '((0 . "SPLINE")))))
((= NUMBER 1) (setq SS (ssget '((0 . "*POLYLINE")))))
((= NUMBER 2) (setq SS (ssget '((0 . "*POLYLINE,SPLINE")))))
(t (setq SS (ssget '((0 . "SPLINE")))))
    )
    ;;
    (if (and SS
      (setq OBJ_0 (entsel "\n请选择剖面线: "))
      (= (cdr (assoc 0 (entget (car OBJ_0)))) "LINE") ;_目前只支持直线段
)
(progn
     ;;转化对象类型
     (setq OBJ_0 (vlax-ename->vla-object (car OBJ_0)))

     ;;获取交点
     (setq LST_PT '()
    I 0
     )
     (repeat (sslength SS)
  (setq OBJ_1  (vlax-ename->vla-object (ssname SS I))
        TMP    (ZL-GETINTERS OBJ_0 OBJ_1 0 "F2" NIL)
        LST_PT (append TMP LST_PT)
  )
  (setq I (1+ I))
     )
     ;; 排序
     ;; 点表按照xyz从小到大排序
     (setq LST_PT (vl-sort LST_PT
      '(lambda (P1 P2)
           (< (cadr P1) (cadr P2))
       )
    )
    LST_PT (vl-sort LST_PT
      '(lambda (P1 P2)
           (< (car P1) (car P2))
       )
    )
     )
     ;;绘制
     (command "_.3dpoly")
     (foreach PT LST_PT
  (command "non" PT)
     )
     (command "")
     ;;显示
     (foreach PT LST_PT
  (princ PT)
     )

     (princ "程序完毕")
)
    )
    (princ)
)


;;;=============================================================================


;|;;===========================================================================
      通用函数                                                                ;
功能：求两个线条对象的交点                                                    ;
      适用对象: Line、Circle、Arc、Ellipse、Polyline、                        ;
      LWPolyline、3dPolyline、Spline                                          ;
参数：OBJ1   ----对象1                                                        ;
      OBJ2   ----对象2                                                        ;
      Extend ----延伸选项                                                     ;
                 0  acExtendNone                                              ;
                 1  acExtendThisEntity                                        ;
                 2  acExtendOtherEntity                                       ;
                 3  acExtendBoth                                              ;
      ZZZ    ----输出选项                                                     ;
                 "=0"  Z值取0                                                 ;
                 "F1"  取第一个对象上的点                                     ;
                 "F2"  取第二个对象上的点                                     ;
                 "MAX" 取Z值大者                                              ;
                 "MIN" 取Z值小者                                              ;
      Fuzz   ----允许偏差值                                                   ;
返回：若成功，返回点位表；否则返回nil
日期：zml84 于2007-11-05
;;|;
(vl-load-com)
(defun ZL-GETINTERS (OBJ1   OBJ2   EXTEND ZZZ  FUZZ /      ENT1
       ENT2   PT10   PT11   PT20  PT21 OBJ11  OBJ22
       ARRAY  LST    LST_PT I  PT PT1    PT2
       Z1     Z2
      )
    ;;0、对参数的格式化处理
    (if (and (= (type EXTEND) 'INT)
      (<= 0 EXTEND 3)
)
()
(setq EXTEND 0)
    )
    (setq ZZZ (strcase ZZZ))
    ;;======================
    ;;1、获取交点集合>>>>>>>
    (if (and (= (vla-get-objectname OBJ1) "AcDbLine")
      (= (vla-get-objectname OBJ2) "AcDbLine")
)
;;对直线对象(line) 特别处理
(progn
     (setq ENT1 (entget (vlax-vla-object->ename OBJ1))
    ENT2 (entget (vlax-vla-object->ename OBJ2))
     )
     (setq PT10 (assoc 10 ENT1)
    PT11 (assoc 11 ENT1)
    PT20 (assoc 10 ENT2)
    PT21 (assoc 11 ENT2)
     )
     ;;去除Z坐标
     (setq PT10 (list (cadr PT10) (caddr PT10))
    PT11 (list (cadr PT11) (caddr PT11))
    PT20 (list (cadr PT20) (caddr PT20))
    PT21 (list (cadr PT21) (caddr PT21))
     )
     (setq LST (inters PT10 PT11 PT20 PT21 t))
     (if LST
  (setq LST (append LST '(0)))
     )
)
(progn
     ;;=====================
     ;;复制实体
     (setq OBJ11 (vla-copy OBJ1)
    OBJ22 (vla-copy OBJ2)
     )
     ;;向xy平面投影，将Z坐标改为0
     (TOXY OBJ11)
     (TOXY OBJ22)
     ;;获取交点集合
     (setq ARRAY (vla-intersectwith OBJ11 OBJ22 EXTEND))
     ;;删除复制后的对象
     (vla-delete OBJ11)
     (vla-delete OBJ22)
     ;;由数组转换为表
     (if (and ARRAY
       (> (vlax-safearray-get-u-bound
       (vlax-variant-value ARRAY)
       1
   )
   1
       )
  )
  (progn
      (setq LST (vlax-safearray->list
      (vlax-variant-value ARRAY)
         )
      )
  )
     )
)
    )
    ;;======================
    ;;2、分析整理>>>>>>>
    (setq LST_PT '())
    (if LST
(progn
     (setq I 0)
     (repeat (/ (length LST) 3)
  ;;2.1 获取当前点位
  (setq PT (list (nth I LST)
          (nth (+ 1 I) LST)
          (nth (+ 2 I) LST)
    )
  )
  ;;2.2 获取对象上对应点位
  (setq PT1 (vlax-curve-getclosestpointtoprojection
         OBJ1
         PT
         '(0 0 1)
     )
        PT2 (vlax-curve-getclosestpointtoprojection
         OBJ2
         PT
         '(0 0 1)
     )
  )
  (setq Z1 (caddr PT1)
        Z2 (caddr PT2)
  )

  ;;2.3 效验偏差值
  ;;就是说：过滤:参数中有偏差值选项，却不满足要求的点位
  (if (and FUZZ
    (or (= (type FUZZ) 'REAL)
        (= (type FUZZ) 'INT)
    )
    (not (equal Z1 Z2 FUZZ))
      )
      ;; 空处理
      ()
      ;;2.4 对输出选项的处理
      (progn
   (cond
       ((= ZZZ "F1")
        (setq PT PT1)
       )
       ((= ZZZ "F2")
        (setq PT PT2)
       )
       ((= ZZZ "MAX")
        (if (> Z1 Z2)
     (setq PT PT1)
     (setq PT PT2)
        )
       )
       ((= ZZZ "MIN")
        (if (< Z1 Z2)
     (setq PT PT1)
     (setq PT PT2)
        )
       )
       (t
        (setq PT PT)
       )
   ) ;_结束cond
   (if (member PT LST_PT)
       ()
       (setq LST_PT (cons PT LST_PT))
   )
      ) ;_结束progn
  ) ;_结束if
  (setq I (+ I 3))
     ) ;_结束repeat
) ;_结束progn
    ) ;_结束if
    ;;3、返回结果>>>>>
    LST_PT
) ;_结束defun
;;;============================================================
;;;功能：曲线实体上每个控制点的z坐标值置为0.0                  
(defun TOXY (OBJ / NAME PT1 TP2)
    ;;取得实体的类型名称
    (setq NAME (vla-get-objectname OBJ))
    (cond
;;类型1
;;直线(line)
((= NAME "AcDbLine")
  ;;取得直线的起终点坐标
  (setq PT1 (vlax-variant-value (vla-get-startpoint OBJ))
        PT2 (vlax-variant-value (vla-get-endpoint OBJ))
  )
  ;;改变z值为0.0
  (vlax-safearray-put-element PT1 2 0.0)
  (vlax-safearray-put-element PT2 2 0.0)
  (vla-put-startpoint OBJ PT1)
  (vla-put-endpoint OBJ PT2)
)
;;类型2
;;圆(circle)
;;圆弧(arc)
;;椭圆及椭圆弧(ellipse)
((or (= NAME "AcDbCircle")
      (= NAME "AcDbArc")
      (= NAME "AcDbEllipse")
  )
  ;;取得中心点座标
  (setq PT1 (vlax-variant-value (vla-get-center OBJ)))
  ;;改变中心点座标z值为0.0
  (vlax-safearray-put-element PT1 2 0.0)
  (vla-put-center OBJ PT1)
)
;;类型3
;;多段线(polyline、lwpolyline)
;;拟合的2维多段线(polyline、lwpolyline)
((or (= NAME "AcDbPolyline")
      (= NAME "AcDb2dPolyline")
  )
  ;;改变标高值为0.0
  (vla-put-elevation OBJ 0.0)
)
;;类型4
;;三维多段线(3dpolyline)  
((= NAME "AcDb3dPolyline")
  ;;取得3维多段线的控制点
  (setq PT1 (vlax-variant-value (vla-get-coordinates OBJ))
        I   0
  )
  (repeat (/ (length (vlax-safearray->list PT1)) 3)
      (vlax-safearray-put-element PT1 (+ I 2) 0.0)
      (setq I (+ I 3))
  )
  (vla-put-coordinates OBJ PT1)
)
;;类型5
;;样条曲线(Spline)
((= NAME "AcDbSpline")
  ;;取得样条曲线的拟合点
  ;;改变每个拟合点的z值为0.0
  (setq PT1 (vlax-variant-value (vla-get-fitpoints OBJ))
        I   0
  )
  (repeat (vla-get-numberoffitpoints OBJ)
      (vlax-safearray-put-element PT1 (+ I 2) 0.0)
      (setq I (+ I 3))
  )
  (vla-put-fitpoints OBJ PT1)
  ;;取得样条曲线的控制点
  ;;改变每个控制点的z值为0.0  
  (setq
      PT2 (vlax-variant-value (vla-get-controlpoints OBJ))
      I  0
  )
  (repeat (vla-get-numberofcontrolpoints OBJ)
      (vlax-safearray-put-element PT2 (+ I 2) 0.0)
      (setq I (+ I 3))
  )
  (vla-put-controlpoints OBJ PT2)
)
(t NIL)
    )
) ;_结束defun
http://www.znch.net/showcourse.asp?id=61
本文来自: <a href=http://www.znch.net>[中南测绘信息中心]</a> 详细出处参考：<a href=http://www.znch.net/showcourse.asp?id=61>http://www.znch.net/showcourse.asp?id=61</a>

清风明月名字

太谢谢楼主了，我正需要这个呢。