查找特定点

nlandry83 · 发表于 2022-7-6 21:43:24

我需要使用VBA找到多段线内圆弧特定点的坐标。我不确定这个点叫什么，但基本上是两条线的顶点，如果使用fillet命令，将创建多段线中显示的圆弧。我附上了一张照片，显示我在寻找什么。

BIGAL · 发表于 2022-7-6 22:01:02

IP交点，无代码而非lisp vba方法。net all有一种方法可以计算出你选择的pline的哪一段，所以简单来说，你可以画两条新的线，并计算出交点，然后删除两条线，你也可以使用光线线，因此实际上不存在。旧的lisp INTERS命令支持四点相交（INTERS p1 p2 p3 p4）解决方案v的vl instersectwith，该解决方案需要两个对象。

因此，如果有人不尽快回答，请搜索VBA pline段等。

BIGAL · 发表于 2022-7-6 22:10:28

有时发现这是在lisp中，但很容易转换为VBA

在代码中，不检查是否拾取了半径或直线。line命令是为了让您可以看到结果。

它并不完美，需要更多的时间，有问题的半径是最后一段，但关闭。

copy


; 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 (nth  seg1 co-ord))
(setq pt3 (nth (1- seg2) co-ord))
(setq pt4 (nth  seg2 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)

nlandry83 · 发表于 2022-7-6 22:21:59

谢谢你，比格尔。这似乎对B点有效，但对其他两点无效。我想换个方向，但不确定怎么做。有没有办法拉动多段线内所有直线的交点？所以，基本上忽略了所有的弧。但我仍然需要保持多段线不变。

lrm · 发表于 2022-7-6 22:31:57

这里有一个简单的过程，您可以手动拾取弧段的起点、终点和中心，以找到交点。将osnap设置为end和cen时使用它。您可以调整该过程以处理多段线的所有弧段。

copy


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

nlandry83 · 发表于 2022-7-6 22:41:11

谢谢Irm。它工作得很好！不过，我在适应VBA时遇到了一些问题。主要是方程的“角度”和“极性”部分。你知道如何将其适应VBA吗？

lrm · 发表于 2022-7-6 22:51:20

我没有访问AutoCAD/VBA的权限，但使用Excel/VBA编写了以下内容，您可以将其应用于AutoCAD/VBA。

我使用了一些向量代数（即叉积）而不是tri来确定圆弧与径向线的垂直线，因为它避免了垂直线（斜率=0）的潜在问题。请注意，对向180°的弧将导致错误，因为到弧端点的切线是平行的，因此不相交。

copy


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

[编程交流] 查找特定点

发表回复

精选推荐