过2点与多段线的交点
本帖最后由 自贡黄明儒 于 2022-2-11 11:53 编辑经过2点如果有构造线，求其与多段线的交点，因为两个实体都存在，用vla-IntersectWith就可以求得交点。
我碰到多次了，只知道2点，但经过2点的构造线XLINE不存在，我只好产生一条构造线XLINE来求交点，完成任务后删除这条构造线XLINE。于是产生了一个想法，是不是仅通过计算就能得到交点呢。
这种想法很久了，今天才完成，以支持明经恢复，欢迎大家测试.
;;1 [功能]两点是否与多段线有交点，延长两点来判断
;;;定义三点的行列式,即三点之倍面积
;;注p1 p2 p3 逆时针为正。
(defun det (p1 p2 p3 / x2 y2)
(setq x2 (car p2)
y2 (cadr p2)
)
(- (* (- x2 (car p3)) (- y2 (cadr p1)))
(* (- x2 (car p1)) (- y2 (cadr p3)))
)
)
;;[功能] 4点求交点(仿vla-IntersectWith）
;;acextendnone 0 不延伸
;;acextendthisentity 1 延伸基准点
;;acextendotherentity 2
;;acextendboth 3
(defun My:4pInters (p1 p2 p3 p4 Flag)
(cond ((= Flag 0) (inters p1 p2 p3 p4 T))
((= Flag 1)
(if (= (minusp (det p1 p2 p3)) (minusp (det p1 p2 p4)))
(inters p1 p2 p3 p4 T)
(inters p1 p2 p3 p4 nil)
)
)
((= Flag 2)
(if (= (minusp (det p3 p4 p1)) (minusp (det p3 p4 p2)))
(inters p1 p2 p3 p4 T)
(inters p1 p2 p3 p4 nil)
)
)
((= Flag 3) (inters p1 p2 p3 p4 nil))
)
)
;;2 [功能]两点与弧是否有交点
;;2点与圆的交点 By Highflybird
(defun IntersLineCircle (p1 p2 cp r / p0 d n s)
(setq n(mapcar '- p2 p1) ;_ 新投影面的法向量
P1 (trans p1 0 n) ;_ P1坐标转换到新投影面n
cp (trans cp 0 n) ;_ CP坐标转换到新投影面n
p0 (list (car p1) (cadr p1) (caddr cp)) ;_ P0在新投影面坐标
)
(cond
((equal r (setq d (distance cp p0)) 1e-7) ;_ 直线和园相切,考虑计算误差
(list (trans p0 n 0))
)
((< d r) ;_ 相交
(setq s (sqrt (- (* r r) (* d d))))
(list
(trans (list (car p1) (cadr p1) (- (caddr cp) s)) n 0) ;_ J1坐标
(trans (list (car p1) (cadr p1) (+ (caddr cp) s)) n 0) ;_ J2坐标
)
)
)
)
;;2点与弧的交点'((-406.036 286.692 0.0) (416.036 286.692 0.0))
;;(setq L '((5033.03 7264.11 0.0) (5652.18 6834.35 0.0)))
(defun My:2pArcInters (e p1 p2 cp r / L x)
(setq L (IntersLineCircle p1 p2 cp r))
(if L
(setq L (mapcar '(lambda (x)
(if (equal (vlax-curve-getclosestpointto e x) x 1e-2)
x
)
)
L
)
)
)
(vl-remove 'nil L)
)
;;3 [功能] 2点与多段线交点
;;'((5033.03 7264.11 0.0) (5608.24 6864.85)),三维点表示2点延长线与弧的交点，二维点表示与直线延长交点
(defun 2PLwpolylineInters (e p3 p4 / A CP EN I L P1 P2 PP R SR Flag)
setq en (entget e))(setq Flag (= (cdr (assoc 70 en))1));T,表示闭合
(setq en (vl-remove-if-not
'(lambda (x)
(or (= (car x) 42) (= (car x) 10))
)
en
)
)
(if Flag
(setq en (append en (List (car en))))
)
(setq i -1)
(while (setq i(1+ i)
p1 (cdar en)
en (cdr en)
sr (cdar en)
en (cdr en)
p2 (cdar en)
)
(if (equal sr 0)
(if (setq a (My:4pInters p1 p2 p3 p4 2))
(setq L (append L (list a)))
)
(progn
(setq pp (vlax-curve-getPointAtParam e (+ i 0.5)))
(if (minusp (car (trans (mapcar '- pp p2) 0 (mapcar '- p1 p2))))
(setq cp (mapcar '- pp (vlax-curve-getsecondderiv e (+ i 0.5))))
(setq cp (mapcar '+ pp (vlax-curve-getsecondderiv e (+ i 0.5))))
)
(setq r (distance p1 cp))
(setq L (append L (My:2pArcInters e p3 p4 cp r)))
)
)
)
L
)
;;测试
(defun C:a1 (/ E P3 P4)
(setq e (car (entsel))) ;选择一个多段线
(setq p3(getpoint) p4(getpoint));选择两点
(2PLwpolylineInters e p3 p4)
)
;;(command "line" x)
ddbegg 发表于 2022-4-5 10:43
大师有没有办法把两个方向的交点分开？也就是说能不能求出只延伸一个方向的交点（另一个方向不延伸）
最近刚好也有相同的需求，多谢黄大师共享代码。
主要是有点疑问：
在实际应用中，究竟是这种纯计算的方法效率更高，还是使用生成辅助线再删除的效率更高呢？ 本帖最后由 wzg356 于 2022-2-11 21:18 编辑
数学几何计算对计算机是小儿科，主要是过程中的表处理/循环带来的效率折减
从过程及效果上讲还是用你最初的土办法“两对象交点”更好 黄大师好久不见，感谢分享。 感谢大佬分享新作 非常感谢分享 黄大师好久不见，感谢分享。 大师有没有办法把两个方向的交点分开？也就是说能不能求出只延伸一个方向的交点（另一个方向不延伸） xyp1964 发表于 2022-4-5 13:42
非常感谢分享
页:
[1]
2