AutoLisp生成统一平面的计算交点
[生成统一平面的计算交点，再返回到线上，但存在个bug，vlax-curve-getClosestPointTo 是垂直方向最近点，存在狠斜时坐标返回错位，使用vlax-curve-getClosestPointToProjection，部分情况下投影点也错了，还有其他方法吗(defun getIntersectwith (obj cutobj / typ cpobj
pte pts ptc intPoints
entobj entcpobj objlen ptcls FunMap
ptdt
)
(defun FunMap (x)
(vlax-curve-getClosestPointTo
obj
(ZC_GETCLOSESTPOINTTO obj x)
t
)
)
(setq intPoints (vlax-invoke obj 'intersectwith cutobj acextendnone))
;;获取交点
(if (or (not intPoints) (= (type intPoints) vlax-vbEmpty))
(progn
(setq cpobj (CopynewObj obj))
(setq typ (vla-get-ObjectName obj))
(cond
((MEMBER typ '("AcDbPolyline" "AcDb2dPolyline"))
(VLA-PUT-ELEVATION cpobj 0)
)
((= typ "AcDbLine")
(set3dPtToZero cpobj "StartPoint")
(set3dPtToZero cpobj "endPoint")
)
((MEMBER typ '("AcDbArc" "AcadEllipse"))
(set3dPtToZero cpobj "StartPoint")
(set3dPtToZero cpobj "endPoint")
(set3dPtToZero cpobj "Center")
)
((= typ "AcDbCircle")
(set3dPtToZero cpobj "Center")
)
((MEMBER typ '("AcDb3dPolyline" "AcDbMLine"))
(set3dPtstoZero cpobj "Coordinates")
)
((= typ "AcDbSpline")
(set3dPtstoZero cpobj "FitPoints")
)
((MEMBER typ '("AcDbRay " "AcDbXline "))
(set3dPtToZero cpobj "BasePoint")
(set3dPtToZero cpobj "SecondPoint")
)
)
(setq intPoints
(vlax-invoke cpobj 'intersectwith cutobj acextendnone)
)
(if (setq intPoints (LST3D->PTLIST intPoints))
(setq intPoints (mapcar 'FunMap intPoints))
)
(vla-delete cpobj)
(vl-remove 'nil intPoints)
)
(LST3D->PTLIST intPoints)
)
)
页:
[1]