ployline spline

[Coolmo]

How do you spline a polyline in VBA? I can set a thickness via
Polylineobject.ConstantWidth = Thickness but what is used for splining the polyline?

[jwanstaett]

Polylineobject is a AcadPolyline not a AcadLWPolyline

AcadLWPolyline need to be change to AcadPolyline

Polylineobject.Type = acQuadSplinePoly


Polyline uses the acPolylineType enum; read-write

acSimplePoly A simple polyline.

acFitCurvePoly A fit curve polyline.

acQuadSplinePoly A quadratic B-spline polyline.

acCubicSplinePoly A cubic B-spline polyline.

[Coolmo]

Here's what I have for code and it still gives me an error....


Dim refpoly As AcadLWPolyline
Dim refpolypnt As Variant
ThisDrawing.Utility.GetEntity refpoly, refpolypnt, "Select reference polyline"
refpoly.Type = acQuadSplinePoly

What am I missing here? Everything works fine if I leave out the last line but I need to spline the line after it is picked.

[Ed Jobe]

The AcadLWPolyline object does not have Type property, only the AcadPolyline object does. You should also check the object type of the ent that was picked. What if they picked a circle? If they pick any object other than a lwp, they will get a runtime error when vba tries to set the picked obect to your var. To avoid this, dim your var as AcadEntity. Then after the GetEnt, use the TypeOf statement in an If statement to check for AcadPolyline.

[jwanstaett]

refpolypnt is a AcadLWPolyline need to change is to a AcadPolyline before you can use the Type Property on it. AcadLWPolyline do not support spline or Curve Fit. If you use the Pedit command on a AcadLWPolyline to make it a spline AutoCAD will first change the AcadLWPolyline to AcadPolyline.



Here's what I have for code and it still gives me an error....


Dim refpoly As AcadLWPolyline
Dim refpolypnt As Variant
ThisDrawing.Utility.GetEntity refpoly, refpolypnt, "Select reference polyline"
refpoly.Type = acQuadSplinePoly

What am I missing here? Everything works fine if I leave out the last line but I need to spline the line after it is picked.

[Coolmo]

I do have a quick error handler in there where if you pick something that doesn't work it tells you to pick again so that's not a problem. Ultimately though, the "Polylines" that the user will pick are going to be LWpolylines because they will be freshly drawn before the VBA program is initialized so can someone show me some quick code for changing them to simple Polylines? I understand I'll need to list the type of entity selected and run the conversion if the entity is LWpolyline but changing the picked LWpolyline to a simple Polyline stumps me.

I appreciate all this help!

[jwanstaett]

try this sub will return a Polyline the same as the Lwpolyline
if deleteLwPolyine = true the Lwplyline is deleted




Public Function LWPolylineToPolyline(LwPolyLine As AcadObject, Optional DeleteLwPolyline As Boolean = False, Optional displayMsg As Boolean = False)
Dim x() As Double
Dim sw As Double
Dim ew As Double
Dim LwWitdh, PlWitdh
Dim acadObj As AcadObject
Dim z, j, i, y
Dim newPline As AcadPolyline
If TypeOf LwPolyLine Is AcadLWPolyline Then
y = LwPolyLine.Coordinates
z = (UBound(y) + 1) / 2
j = (z * 3) - 1
ReDim x(j)
For i = 0 To z - 1
x(i * 3) = y(i * 2)
x(i * 3 + 1) = y(i * 2 + 1)
x(i * 3 + 2) = 0
Next
Set acadObj = LwPolyLine.Document.ObjectIdToObject(LwPolyLine.OwnerID)
If TypeOf acadObj Is AcadBlock Then
'ACADOBJ to PLACE TO THE NEW POLYLINE
'I do this so you can work in paperscape or modle space
Set newPline = acadObj.AddPolyline(x)
For j = 0 To z - 1
LwPolyLine.GetWidth j, sw, ew
newPline.SetWidth j, sw, ew
newPline.SetBulge j, LwPolyLine.GetBulge(j)
Next
newPline.Layer = LwPolyLine.Layer
newPline.Linetype = LwPolyLine.Linetype
newPline.Color = LwPolyLine.Color
newPline.Closed = LwPolyLine.Closed
newPline.Elevation = LwPolyLine.Elevation
newPline.LinetypeGeneration = LwPolyLine.LinetypeGeneration
newPline.LinetypeScale = LwPolyLine.LinetypeScale
newPline.Lineweight = LwPolyLine.Lineweight
newPline.Normal = LwPolyLine.Normal
newPline.Thickness = LwPolyLine.Thickness
newPline.Visible = LwPolyLine.Visible

If DeleteLwPolyline Then LwPolyLine.Delete
Else
If displayMsg Then
MsgBox "LwPolyLine not in a block", vbOKOnly, "LwPolylineToPolyline By John W Anstaett"
End If
Set newPline = Nothing
End If
Else
If displayMsg Then
MsgBox "LwPolyLine not Selected", vbOKOnly, "LwPolylineToPolyline By John W Anstaett"
End If
Set newPline = Nothing
End If
Set LWPolylineToPolyline = newPline
End Function