autocadvba - place circle on the poinr of a polygon?

[clarence_cad]

my task is : select a polygon and then place circle with specified radius on all the points of a polygon autoimatically.

can anyone help..?? Thanks a lot!

[Tommy]

Hi clarence_cad,

Are you at Autodesk's VBA customazation dicussion group?

The below sub will take an active selection set and place circles at each vertex.


Sub CircleAtPlineVertex()
Dim mCrcle As AcadCircle, mTmp As AcadEntity, mN As Long, mX(2) As Double, mY(2) As Double
Dim mI As Long, mPline As Acad3DPolyline, mLWPline As AcadLWPolyline
For mI = ThisDrawing.ActiveSelectionSet.Count - 1 To 0 Step -1
If InStr(1, ThisDrawing.ActiveSelectionSet(mI).ObjectName, "3dPolyline") > 0 Then
Set mPline = ThisDrawing.ActiveSelectionSet.Item(mI)
For mN = 0 To UBound(mPline.Coordinates, 1) Step 3
mX(0) = mPline.Coordinates(mN)
mX(1) = mPline.Coordinates(mN + 1)
mX(2) = mPline.Coordinates(mN + 2)
Set mCrcle = ThisDrawing.ModelSpace.AddCircle(mX, 2)
Next
ElseIf InStr(1, ThisDrawing.ActiveSelectionSet(mI).ObjectName, "Polyline") > 0 Then
Set mLWPline = ThisDrawing.ActiveSelectionSet.Item(mI)
For mN = 0 To UBound(mLWPline.Coordinates, 1) Step 2
mY(0) = mLWPline.Coordinates(mN)
mY(1) = mLWPline.Coordinates(mN + 1)
mY(2) = 0
Set mCrcle = ThisDrawing.ModelSpace.AddCircle(mY, 2)
Next
End If
Next
ThisDrawing.Regen acActiveViewport
Set mCrcle = Nothing
Set mLWPline = Nothing
Set mPline = Nothing
End Sub

[lucas]

I don't understand how you control the radius or diameter of the circles?

[Tommy]

In the below statement mY is the array of points and 2 is the radius. On the 2 I could have used anything, it was just on my sample drawing 2 worked without overlapping.



Set mCrcle = ThisDrawing.ModelSpace.AddCircle(mY, 2)

[lucas]

Thanks Tommy, I'm gonna add that comment to the code so when I come back later I'll know what we did to change the radius.