查找特定点
我需要使用VBA找到多段线内圆弧特定点的坐标。我不确定这个点叫什么，但基本上是两条线的顶点，如果使用fillet命令，将创建多段线中显示的圆弧。我附上了一张照片，显示我在寻找什么。IP交点，无代码而非lisp vba方法。net all有一种方法可以计算出你选择的pline的哪一段，所以简单来说，你可以画两条新的线，并计算出交点，然后删除两条线，你也可以使用光线线，因此实际上不存在。旧的lisp INTERS命令支持四点相交（INTERS p1 p2 p3 p4）解决方案v的vl instersectwith，该解决方案需要两个对象。
因此，如果有人不尽快回答，请搜索VBA pline段等。 有时发现这是在lisp中，但很容易转换为VBA
在代码中，不检查是否拾取了半径或直线。line命令是为了让您可以看到结果。
它并不完美，需要更多的时间，有问题的半径是最后一段，但关闭。
; Intersection point of plines where radius exists
; By Alan H June 2019
(defun PSN (plsel / )
(1+
(fix
(vlax-curve-getParamAtPoint (car plsel)
(osnap (cadr plsel) "_nea")
)
)
)
)
(defun ah:IPP (/pt1 pt2 pt3 pt4 pt5 seg1 seg2 plent)
(setq plent (entsel "Select Polyline Radius"))
(setq seg1 (- (psn plent) 1))
(setq seg2 (+ seg1 2))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
(if (> seg2 (length co-ord))(setq seg2 1))
(setq pt1 (nth (1- seg1) co-ord))
(setq pt2 (nthseg1 co-ord))
(setq pt3 (nth (1- seg2) co-ord))
(setq pt4 (nthseg2 co-ord))
(if (= pt4 nil)(setq pt4 (nth 0 co-ord)))
(setq pt5 (inters pt1 pt2 pt3 pt4 nil))
(command "line" pt5 (list 0 0) "")
(princ)
)
(ah:IPP)
谢谢你，比格尔。这似乎对B点有效，但对其他两点无效。我想换个方向，但不确定怎么做。有没有办法拉动多段线内所有直线的交点？所以，基本上忽略了所有的弧。但我仍然需要保持多段线不变。 这里有一个简单的过程，您可以手动拾取弧段的起点、终点和中心，以找到交点。将osnap设置为end和cen时使用它。您可以调整该过程以处理多段线的所有弧段。
(defun c:AV (/ p1 p2 p3 p4 p ang osm)
(setq p1 (getpoint "\nSelect arc beginning.")
p2 (getpoint p1 "\nSelect arc end.")
pctr (getpoint p2 "\nSelect arc center.")
ang(angle pctr p1)
p3 (polar p1 (+ ang (/ pi 2.)) 10)
ang(angle pctr p2)
p4 (polar p2 (+ ang (/ pi 2.)) 10)
p (inters p1 p3 p2 p4 nil)
)
(setq osm (getvar "osmode"))
(command "_line" pctr p "")
(setvar "osmode" osm)
(princ)
) 谢谢Irm。它工作得很好！不过，我在适应VBA时遇到了一些问题。主要是方程的“角度”和“极性”部分。你知道如何将其适应VBA吗？ 我没有访问AutoCAD/VBA的权限，但使用Excel/VBA编写了以下内容，您可以将其应用于AutoCAD/VBA。
我使用了一些向量代数（即叉积）而不是tri来确定圆弧与径向线的垂直线，因为它避免了垂直线（斜率=0）的潜在问题。请注意，对向180°的弧将导致错误，因为到弧端点的切线是平行的，因此不相交。
Sub ArcVertex()
Range("B2:b2").Select
p1x = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
p1y = ActiveCell.Value
ActiveCell.Offset(1, -1).Select
p2x = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
p2y = ActiveCell.Value
ActiveCell.Offset(1, -1).Select
pcenx = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
pceny = ActiveCell.Value
Call cross(pcenx - p1x, pceny - p1y, 0, 0, 0, 1, p3x, p3y, p3z)
p3x = p3x + p1x
p3y = p3y + p1y
Call cross(pcenx - p2x, pceny - p2y, 0, 0, 0, 1, p4x, p4y, p4z)
p4x = p4x + p2x
p4y = p4y + p2y
Range("B6:B6").Select
ActiveCell.Value = p3x
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = p3y
ActiveCell.Offset(1, -1).Select
ActiveCell.Value = p4x
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = p4y
pintx = ((p3x * p1y - p1x * p3y) * (p4x - p2x) - (p4x * p2y - p2x * p4y) * (p3x - p1x)) / _
((p3x - p1x) * (p4y - p2y) - (p4x - p2x) * (p3y - p1y))
pinty = ((p3x * p1y - p1x * p3y) * (p4y - p2y) - (p4x * p2y - p2x * p4y) * (p3y - p1y)) / _
((p3x - p1x) * (p4y - p2y) - (p4x - p2x) * (p3y - p1y))
ActiveCell.Offset(1, -1).Select
ActiveCell.Value = pintx
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = pinty
End Sub
Sub cross(ax, ay, az, bx, by, bz, cx, cy, cz)
cx = ay * bz - az * by
cy = az * bx - ax * bz
cz = ax * by - ay * bx
End Sub
页:
[1]