[求助]求两个线条对象的交点lisp

mj520plus · 发表于 2010-10-13 17:20:00

这个程序运行有问题，请高手帮忙！！！

;|;;===========================================================================
通用函数 ;
功能：求两个线条对象的交点 ;
适用对象: 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);将 Visual LISP 扩展功能加载到 AutoLISP
(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

;|;;=========================================================================== 
通用函数 ; 
功能：求两个线条对象的交点 ; 
适用对象: 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);将 Visual LISP 扩展功能加载到 AutoLISP 
(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

账号		自动登录	找回密码
密码			注册