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. )

复制代码