1条路径上有2个点
你好我尝试了几种方法让2个点（圆环，见下图）跟随绘图路径（多段线）。我用arraypath等试过了。
它不起作用，我也没有找到任何解决这个问题的方法。有人能帮我吗？我使用Autocad 2013。
两个圆必须始终遵循多段线路径，且圆之间的距离相同。就像火车或有轨电车一样。用户必须能够输入必须复制的对象之间的特定距离，并且用户还必须能够选择必须复制的次数。
请问，有人知道解决方案吗？
Thx提前。
measure命令
我也试过了，但没用。总是有一个圆不遵循路径。 执行，但插入块或AutoCAD点（点）。做得很好。
您尝试使用的附图
我本以为该测度将沿曲线给出相等的长度，但不是OP所要求的，即相等的弦长。
我可能会使用一个合适的块，并将其旋转以实现所需的对齐。 有一种方法可以将一个块放置在pline上，第一个插入点是圆的中心点，第二个旋转点是计算出来的，块旋转到这个角度，代码在VBA中，但我现在要在VL中做，变量crad是中心之间的距离，试图制作一个称为“holden”的块
Sub draw_vehicle()
Dim CAR As String
Dim arcobj As AcadArc
Dim oPoly As AcadEntity
Dim blkobj As AcadEntity
Dim retVal As Variant
Dim snapPt As Variant
Dim oCoords As Variant
Dim blpnt1() As Variant
ReDim blpnt1(100)
Dim blpnt2() As Variant
ReDim blpnt2(100)
Dim vertPt(0 To 2) As Double
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim newPt(0 To 2) As Double
Dim iCnt, w, x, y, z As Integer
Dim cRad, interval, blkangle As Double
Dim circObj As AcadCircle
Dim lineObj As AcadLine
On Error GoTo Something_Wrong
If ThisDrawing.ActiveSpace = acModelSpace Then
Set Thisspace = ThisDrawing.ModelSpace
Else: Set Thisspace = ThisDrawing.PaperSpace
End If
For Each Item In ThisDrawing.Blocks
If Item.Name = "holden" Then GoTo continue_on
Next Item
' insert holden block
InsertBlock "p:\Autodesk\vba\holdencar.dwg", 0
continue_on:
w = 1
ThisDrawing.Utility.GetEntity oPoly, snapPt, vbCr & "Select polyline :"
If oPoly.ObjectName = "AcDbPolyline" Then
oCoords = oPoly.Coordinates
Else: MsgBox "This object is not a polyline! Please do again"
Exit Sub
End If
interval = CDbl(InputBox("Enter interval:", , 1#))
If interval < 1 Then
interval = 1
End If
For iCnt = 0 To UBound(oCoords) - 2 Step 2
Pt1(0) = oCoords(iCnt): Pt1(1) = oCoords(iCnt + 1): Pt1(2) = 0#
newPt(0) = Pt1(0)
newPt(1) = Pt1(1)
newPt(2) = 0#
iCnt = iCnt + 2
Pt2(0) = oCoords(iCnt): Pt2(1) = oCoords(iCnt + 1): Pt2(2) = 0#
x = (Pt1(0) - Pt2(0)) / interval
y = (Pt1(1) - Pt2(1)) / interval
'reset back 2 values
iCnt = iCnt - 2
cRad = 3.05
startang = 4.71239
endang = 1.570796
CAR = "HOLDEN"
For z = 1 To interval
vertPt(0) = newPt(0) - x
vertPt(1) = newPt(1) - y
vertPt(2) = 0#
'blpnt1(w) = vertPt
'Set arcobj = ThisDrawing.ModelSpace.AddArc(vertPt, cRad, endang, startang)
Set arcobj = Thisspace.AddArc(vertPt, cRad, endang, startang)
retval2 = arcobj.IntersectWith(oPoly, acExtendOtherEntity)
arcobj.Delete
Set arcobj = Nothing
blkangle = ThisDrawing.Utility.AngleFromXAxis(retval2, vertPt)
'Set blkobj = ThisDrawing.ModelSpace.InsertBlock(vertPt, CAR, 1#, 1#, 1#, blkangle)
Set blkobj = Thisspace.InsertBlock(vertPt, CAR, 1#, 1#, 1#, blkangle)
Set blkobj = Nothing
w = w + 1
newPt(0) = newPt(0) - x
newPt(1) = newPt(1) - y
Next z
Next iCnt
GoTo Exit_out
Something_Wrong:
MsgBox Err.Description
Exit_out:
End Sub
Private Sub InsertBlock1()
'****************************************
'*** Code from VisibleVisual.com ********
'****************************************
InsertBlock "p:\Autodesk\vbaholden.dwg", 0
'Change the 0 to another value (in degrees) to rotate the block'
End Sub
Function InsertBlock(ByVal blockpath As String, ByVal rotation As Double)
Dim blockobj As AcadBlockReference
Dim insertionPnt As Variant
Dim prompt1 As String
'set rotation Angle
rotateAngle = rotation
'rotateAngle = rotation * 3.141592 / 180#
'Prompt is used to show instructions in the command bar
prompt1 = vbCrLf & "Enter block insert point: "
'ThisDrawing.ActiveSpace = acModelSpace
insertionPnt = ThisDrawing.Utility.GetPoint(, prompt1)
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, blockpath, 1#, 1#, 1#, rotateAngle)
'Change Modelspace into Paperspace to insert the block into Paperspace
End Function
您好，在autocadfile下面
2分/秒。图纸
这就是我现在正在做的。但有时它不止一个街区，需要很多时间，有时你跳错了线。
因此，使用lisproutine（如果可能的话）不会出错
Thx，但我不知道如何启动或如何在Autocad上运行VBA程序。不管怎样，我希望你能在VL取得成功
这是autocadfile 2pointspath。图纸 您的问题更复杂，因为您必须将块“TEMP”（在x和y方向上的长度不同）与插入点和计算点对齐，距离等于块的长度。
页:
[1]
2