Set a AutoCAD block

[Anonymous]

Hello there,

can someone help mi with my VBA rule.

I just make a Excel VBA to draw 2 circles in AutoCAD.

Option Explicit
Public path As String
Public ThisDrawing As AcadDocument
Public Pos(0 To 2) As Double
Public Block_Pos(0 To 2) As Double
Public LayerRed As AcadLayer

Public Sub Kreiß()
Set ThisDrawing = AutoCAD.Documents.Add("C:\Users\Aleksandar.Jovicic.FG\Desktop\Kreiß\Kreiß.dwt")
ThisDrawing.Activate

Dim CircleRadius As Double
Dim CircleRadius_2 As Double
Dim acadCircle As Object
Dim acadBlock As Object

Dim Kreiß_bl As acadBlock

Pos(0) = 0: Pos(1) = 0: Pos(2) = 0

Block_Pos(0) = 200: Block_Pos(1) = 200: Block_Pos(2) = 0

Set Kreiß_bl = ThisDrawing.Blocks.Add(Block_Pos, "Kreiß")

CircleRadius = ActiveSheet.Range("Radius")
CircleRadius_2 = ActiveSheet.Range("Radius_innen")

Set acadCircle = ThisDrawing.ModelSpace.AddCircle(Pos, CircleRadius)
Set acadCircle = ThisDrawing.ModelSpace.AddCircle(Pos, CircleRadius_2)

AutoCAD.ZoomExtents

End Sub

Now i need to make block from this two circles ("Kreiß_bl" schuld be the block with Block_Pos)

Can you help me out?

Best regads

Alex

[Alfred.NESWADBA]

Hi,

instead of

   Set acadCircle = ThisDrawing.ModelSpace.AddCircle(Pos, CircleRadius)

you should use

   Set acadCircle = Kreiß_bl.AddCircle(Pos, CircleRadius)

...to add the circle object to the block-definition (and not to the modelspace)

- alfred -

[Anonymous]

Hello Alfred and thank you for the replay

What I muss do to add this block in Model Space with VBA?

Alex

[Alfred.NESWADBA · Accepted solution]

Hi,

>> What I muss do to add this block in Model Space with VBA?

ThisDrawing.Modelspace.InsertBlock(...

as described >>>here<<<.

- alfred -

[Anonymous]

Hello,

I have just one more question

I am using array option via excel vba

And I found this

Dim noOfObjects As Integer
Dim angleToFill As Double
Dim basePnt(0 To 2) As Double
noOfObjects = 5
angleToFill = 3.14
basePnt(0) = 0: basePnt(1) = 0: basePnt(2) = 0

Dim retObj As Variant
retObj = circleObj.ArrayPolar(noOfObjects, angleToFill, basePnt)

The problem is when I use the fill angel 360 (6.28) i have one circle less the 5

[Alfred.NESWADBA]

Hi,

>> The problem is when I use the fill angel 360 (6.28) i have one circle less the 5

What is the centerpoint of the circle? If it's 0,0 then ... 😉

- alfred -

[Anonymous]

Here ist the rest of the vba 

Dim retObj As Variant
retObj = circleObj.ArrayPolar(noOfObjects, angleToFill, basePnt)

basePnt(0) = 0: basePnt(1) = 0: basePnt(2) = 0

[Alfred.NESWADBA]

Hi,

>> Here ist the rest of the vba 

The rest I'm missing is what is the center of the circle that you then use for the array?

- alfred -

[Anonymous]

Hallo Alfred 

So, ich schicke dir jetzt den ganzen VBA Code:

Option Explicit
Public path As String
Public ThisDrawing As AcadDocument
Public Pos(0 To 2) As Double
Public Pos_2(0 To 2) As Double
Public Pos_3(0 To 2) As Double
Public Block_Pos(0 To 2) As Double
Public LayerRed As AcadLayer
Public Const Pi = 3.141592654

Public Sub Kreiß()
Set ThisDrawing = AutoCAD.Documents.Add("C:\Users\Aleksandar.Jovicic.FG\Desktop\Kreiß\Kreiß.dwt")
ThisDrawing.Activate

Dim CircleRadius As Double
Dim CircleRadius_2 As Double
Dim CircleRadius_3 As Double
Dim acadCircle As Object
Dim acadCircle_2 As Object
Dim acadBohrung As Object
Dim acadBlock As Object
Dim circleObj As acadCircle
Dim Kreiß_bl As acadBlock

Dim center(0 To 2) As Double
Dim radius As Double

radius = ActiveSheet.Range("Bohrung")

Pos(0) = 0: Pos(1) = 0: Pos(2) = 0
center(0) = -55: center(1) = 0: center(2) = 0:
Block_Pos(0) = 200: Block_Pos(1) = 200: Block_Pos(2) = 0

Set Kreiß_bl = ThisDrawing.Blocks.Add(Pos, "Kreiß")

CircleRadius = ActiveSheet.Range("Radius")
CircleRadius_2 = ActiveSheet.Range("Radius_innen")
CircleRadius_3 = ActiveSheet.Range("Bohrung")

Set acadCircle = Kreiß_bl.AddCircle(Pos, CircleRadius)
Set acadCircle = Kreiß_bl.AddCircle(Pos, CircleRadius_2)
Set circleObj = Kreiß_bl.AddCircle(center, radius)

Dim blockRefObj As AcadBlockReference
Pos_3(0) = 100: Pos_3(1) = 100: Pos_3(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(Pos_3, "Kreiß", 1, 1, 1, 0)

Dim noOfObjects As Integer
Dim angleToFill As Double
Dim basePnt(0 To 2) As Double
noOfObjects = ActiveSheet.Range("Anzhal")
angleToFill = 6.28
basePnt(0) = 0: basePnt(1) = 0: basePnt(2) = 0

Dim retObj As Variant
retObj = circleObj.ArrayPolar(noOfObjects, angleToFill, basePnt)

AutoCAD.ZoomExtents

End Sub

Ich versuche eine Flanche zu zeichnen. Problem ist wenn ich den "angleToFill" auf 360 bzw. 6.28 umschreibe bekomme ich einen Kreiß (Bohrung) weniger als "noOfObjects"

[Alfred.NESWADBA · Accepted solution]

Hi,

well, I found out a tricky issue: when you defined 2*PI as angle to fill AutoCAD is assuming it's 0° instead of 360°, that's why the objects are all at the same position.

Strange, but reproducible.

>> bekomme ich einen Kreiß (Bohrung) weniger als "noOfObjects"

That's how AutoCAD works, if you create an array of 5 objects from a base object it only has to create 4 objects, as the first one already exists 😉

- alfred -