Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations GregLocock on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Determining weather an object is within another object using a VBA scr 1

Status
Not open for further replies.

flycast

Mechanical
Mar 26, 2001
7
I wish to determine if a circle, arc or line is contained within a polyline using VBA procedure. I have investigated the intersect command but this only works for 3D objects, my objects will be 2d objects.

Any ideas?

Thanks,
Eric
 
Replies continue below

Recommended for you

'ANALYZING A POLYLINE FOR ARCS AND LINES
'
''
'Improvised in one hour exclusively for Mr. FlyCast
'Polyline: this method will fail if the polyline Type property is not acSimplePoly.
'The bulge is the tangent of 1/4 of the included angle for the arc
'between the selected vertex and the next vertex in the polyline’s vertex list.
'A negative bulge value indicates that the arc goes clockwise
'from the selected vertex to the next vertex.
'A bulge of 0 indicates a straight segment, and a bulge of 1 is a semicircle.

Sub AnalysePoly()
' Begin the selection
Dim returnObj As AcadObject
Dim basePnt As Variant
Dim OldColor As Variant
On Error Resume Next
' The following example waits for a selection from the user
RETRY:
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object"
If Err <> 0 Then
Err.Clear
MsgBox &quot;Good Bye.&quot;, , &quot;GetEntity Example&quot;
Exit Sub
Else
OldColor = returnObj.Color
returnObj.Color = acRed
returnObj.Update

If returnObj.EntityName = &quot;AcDbPolyline&quot; Then
msgy = returnObj.EntityName & vbCrLf
Dim retCoord As Variant
retCoord = returnObj.Coordinates

For i = LBound(retCoord) To UBound(retCoord)
'Debug.Print retCoord(i)
Next

verticio = i / 3

For j = 1 To verticio
If returnObj.GetBulge(j) = 0 Then
typo = &quot; Line&quot;
Else
typo = &quot; Arc&quot;
End If
msgy = msgy & vbCrLf & &quot;bulge &quot; & j & &quot; = &quot; & returnObj.GetBulge(j) & typo
Debug.Print &quot;bulge &quot; & j & &quot; = &quot; & returnObj.GetBulge(j) & typo
Next

Debug.Print &quot;coordinates &quot; & i
Debug.Print &quot;Vertices &quot; & i / 3
returnObj.Color = OldColor
returnObj.Update
Else
msgy = &quot;No PolyLine!Object is &quot; & returnObj.EntityName
End If
MsgBox msgy, , &quot; End If
GoTo RETRY
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor