Path Array

[Dormant]

Hi All,

 

Im trying to array a block along a path so that two points on the block are intersecting the path, and also that the points are coincident with each other.

 

Similar to the picture below, if the line where a block.

 

 

Ive tried the built in path array and also the MEASURE and DIVIDE commands with out any luck.

 

Any help appreciated.

 

Regards.

[BIGAL]

Here is a vba program that will allow a block to be inserted along a pline it does basicly what you want but would require modifying to suit your block length needs. I have posted the code as source it basicly takes 2 points and uses intersectwith to work out the block angle. The block is called "Holden" we use it to check vehicle driveways.

 

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


   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

[Dormant]

Thanks BIGAL, this is a great start. I can see the obvious changes like path and block names etc, but I think I will get stuck modifying to suit my block intersecting points which are 11590mm apart.

[BIGAL]

Just change Crad 3.05 is the distance between wheels, for more accurate use the true value of PI as a VBA variable. Startang Endang, create a block horizontal line 11590mm give it your name rather than holden should work then.

[Dormant]

Ok, I managed to get the VBA to run, changed a few things, but not having any luck to get it too array. The program doesn't seem to let me select 2 points on the block which would be the points of intersection on the path, is this correct?