AutoLisp生成统一平面的计算交点

admin

[生成统一平面的计算交点，再返回到线上，但存在个bug，vlax-curve-getClosestPointTo 是垂直方向最近点，存在狠斜时坐标返回错位，使用vlax-curve-getClosestPointToProjection，部分情况下投影点也错了，还有其他方法吗

1. (defun getIntersectwith        (obj          cutobj   /            typ             cpobj
   
2.                          pte          pts           ptc            intPoints
   
3.                          entobj          entcpobj objlen   ptcls    FunMap
   
4.                          ptdt
   
5.                         )
   
6.   (defun FunMap        (x)
   
7.     (vlax-curve-getClosestPointTo
   
8.       obj
   
9.       (ZC_GETCLOSESTPOINTTO obj x)
   
10.       t
    
11.     )
    
12.   )
    
13.   (setq intPoints (vlax-invoke obj 'intersectwith cutobj acextendnone))
    
14.   ;;获取交点
    
15.   (if (or (not intPoints) (= (type intPoints) vlax-vbEmpty))
    
16.     (progn
    
17.       (setq cpobj (CopynewObj obj))
    
18.       (setq typ (vla-get-ObjectName obj))
    
19.       (cond
    
20.         ((MEMBER typ '("AcDbPolyline" "AcDb2dPolyline"))
    
21.          (VLA-PUT-ELEVATION cpobj 0)
    
22.         )
    
23.         ((= typ "AcDbLine")
    
24.          (set3dPtToZero cpobj "StartPoint")
    
25.          (set3dPtToZero cpobj "endPoint")
    
26.         )
    
27.         ((MEMBER typ '("AcDbArc" "AcadEllipse"))
    
28.          (set3dPtToZero cpobj "StartPoint")
    
29.          (set3dPtToZero cpobj "endPoint")
    
30.          (set3dPtToZero cpobj "Center")
    
31.         )
    
32.         ((= typ "AcDbCircle")
    
33.          (set3dPtToZero cpobj "Center")
    
34.         )
    
35.         ((MEMBER typ '("AcDb3dPolyline" "AcDbMLine"))
    
36.          (set3dPtstoZero cpobj "Coordinates")
    
37.         )
    
38.         ((= typ "AcDbSpline")
    
39.          (set3dPtstoZero cpobj "FitPoints")
    
40.         )
    
41.         ((MEMBER typ '("AcDbRay " "AcDbXline "))
    
42.          (set3dPtToZero cpobj "BasePoint")
    
43.          (set3dPtToZero cpobj "SecondPoint")
    
44.         )
    
45.       )
    
46.       (setq intPoints
    
47.              (vlax-invoke cpobj 'intersectwith cutobj acextendnone)
    
48.       )
    
49.       (if (setq intPoints (LST3D->PTLIST intPoints))
    
50.         (setq intPoints (mapcar 'FunMap intPoints))
    
51.       )
    
52.       (vla-delete cpobj)
    
53.       (vl-remove 'nil intPoints)
    
54.     )
    
55.     (LST3D->PTLIST intPoints)
    
56.   )
    
57. )

复制代码