Lisp to rotate blocks along polyline

[woodman78]

Hi all,

Happy new year to everyone!

I am looking to add blocks along a polyline and rotate each block to match the polyline but unlike the measure command I want the end point of the block to be on the polyline. The measure command reads the angle at the insertion point so that the point of the block is not necessarily on the polyline.

 

Can anyone help please?

 

Thanks.

[woodman78]

I was thinking of doing this by drawing a circle at the start of the polyline and finding where that intersects the polyline. The insert the block and rotate it to that point. Then move on 10m and do the same again.

 

Am I heading in the right direction?

[eldon]

It may be a matter of choosing a different insertion point on the block.

 

Perhaps a picture of what you are doing, and why that is not right for you, would be very helpful.

[woodman78]

Thanks Eldon.

 

Here is an image of the block.

 

And I use it, placed along a road profile to determine sight distance (that is clearance above the road surface).

 

[eldon]

I am afraid that it is still not clear to me which point or points of the block should be on the polyline.

 

Perhaps a clearer picture of one block on the polyline would help those who could write the lisp.

[woodman78]

Sorry Eldon, I position the block on the polyline using the rectangular grip and rotate it down onto the line using the dynamic blue grip.

SSD_215m.dwg

[eldon]

I am sorry, but I abrogate all knowledge of dynamic blocks, so you will have to await a more knowledgeable kindly soul

[woodman78]

Thanks Eldon. But it doesn't have to be a dynamic block. I just use that to make rotating easier. A standard block will do just fine as well.

[BIGAL]

Have a look at this it drives a car along a pline. The block length is 2.8m distance between wheels.

(vl-vbaload "P:/VBA/access-rev2.dvb") 
(vl-vbarun "draw_vehicle")

Holden.dwg

access-rev2.zip

[lrm]

How about adding an arc to the block as follows:

 

Insert the block with its base point on the polyline and with a horizontal orientation then use rotate to rotate the block about it bases point (OSNAP INSERT) and use OSNAP INTERSECTION at the point where the arc intersects the polyline. YOu can place the arc on a separate layer and freeze it so it doesn't display or just redefine the block without the arc when you are done.

[woodman78]

Thanks Bigal. I'll check it out when I'm in the office.

[woodman78]

Thanks Irm but I want to automate this process using Lisp or other code.

[BIGAL]

Understand but take the VBA and look at how it works just basicly rewrite using VLISP which has very close syntax INTERSECTWITH etc which is basicly how it works. I have it on my list to redo but as it works and guys are happy its at the bottom.

 

For now just change block name and the 2.8 which is the c-c distance.

[cadplayer]

Is it that you need /D

https://apps.exchange.autodesk.com/ACD/en/Detail/Index?id=appstore.exchange.autodesk.com:rotationblocksattributesonpolylinev2_windows32and64:en

[woodman78]

Bigal,

 

I tried loading your dvb file but it won't load in the ppload window. I cannot see it in operation. Any ideas?

 

Thanks.

[BIGAL]

Check the pathing to the dvb file I had to edit the line above as I altered it when I posted. If it has spaces in directory names try something like p:\\my vba\\access-rev2.dvb.

 

Else just do vbaman and load access-rev2 you should be able to then do (vl-vbarun "draw_vehicle")

 

If you click on Access-rev2 and then pick Visual basic editor it will show the code the spacing bewteen wheels is 3.05 see rde below change that to your spacing and recreate the block 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 = [color=red]3.05[/color]
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

[woodman78]

Hi Bigal,

 

I have found something very close to what I want from LEEMAC. It is his Object Align command. The only issue I have is that it does not align the block to a polyline (see attached image). Can this be modified (with Leemac's permission) to rotate the grip from the block down onto the polyline?

 

Thanks.

 

ObjectAlignV1-3.lsp

[BIGAL]

Manually you draw a circle centre at 1 point other at 2nd point and rotate the block to suit which is what the vba does. Still not sure why you can not get to work just try in holden.dwg

 

One day will rewrite to VLISP.