PDA

View Full Version : How to insert block with vba???



firavolla
14th Jul 2010, 11:04 am
I have a subroutine that should define and declare a block, add elements to it and then insert it in the current drawing at the specified position. The problem is that it works ok only the first time. Afterwords, a various number of blocks are inserted in relative position to the given insertion point. Any help is appreciated. the subroutine goes like this:




Public Sub BlocCota(pIn As Variant, valCota As Double)

'Pt hasura
Dim outerLoop(0 To 0) As AcadEntity
Dim hasura As AcadHatch
Dim hasuraPattern As AcPatternType
Dim hasuraName As String

'pt restul
Dim myBloc As AcadBlock
Dim linie As AcadLine
Dim myPoly As AcadPolyline
Dim myText As AcadText
Dim colPuncte(0 To 8) As Double
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim s As String
s = CStr(valCota)

'Adaugam blocul la desen
Dim contor As Integer
Dim b As Boolean
Dim vX As Integer
b = True
contor = ThisDrawing.Blocks.Count - 1
Dim ind As Integer
For ind = 0 To contor Step 1
If ThisDrawing.Blocks.Item(ind).Name = "sageataNivel" Then
b = False
vX = ind
End If
Next ind

If b = True Then
Set myBloc = ThisDrawing.Blocks.Add(pIn, "sageataNivel")
Else
Set myBloc = ThisDrawing.Blocks.Item(vX)
End If




'Linia ____ de inceput
p1(0) = pIn(0)
p1(1) = pIn(1)
p1(2) = pIn(2)

p2(0) = p1(0) + 5
p2(1) = p1(1)
p2(2) = p1(2)

Set linie = myBloc.AddLine(p1, p2)

'Triunghiul din stanga
colPuncte(0) = p2(0)
colPuncte(1) = p2(1)
colPuncte(2) = p2(2)

colPuncte(3) = colPuncte(0)
colPuncte(4) = colPuncte(1) + 5
colPuncte(5) = colPuncte(2)

colPuncte(6) = colPuncte(3) - 5
colPuncte(7) = colPuncte(4)
colPuncte(8) = colPuncte(5)

Set myPoly = myBloc.AddPolyline(colPuncte)
myPoly.Closed = True

'Triunghiul din dreapta
colPuncte(0) = colPuncte(0)
colPuncte(1) = colPuncte(1)
colPuncte(2) = colPuncte(2)

colPuncte(3) = colPuncte(0)
colPuncte(4) = colPuncte(1) + 5
colPuncte(5) = colPuncte(2)

colPuncte(6) = colPuncte(3) + 5
colPuncte(7) = colPuncte(4)
colPuncte(8) = colPuncte(5)



Set myPoly = myBloc.AddPolyline(colPuncte)
myPoly.Closed = True

Set outerLoop(0) = myPoly
hasuraPattern = acHatchPatternTypePreDefined
hasuraName = "SOLID"
Set hasura = ThisDrawing.ModelSpace.AddHatch(hasuraPattern, hasuraName, True)
hasura.AppendOuterLoop (outerLoop)
hasura.Evaluate


'Linia |
p1(0) = p2(0)
p1(1) = p2(1)
p1(2) = p2(2)

p2(0) = p2(0)
p2(1) = p2(1) + 15
p2(2) = p2(2)

Set linie = myBloc.AddLine(p1, p2)

'Linia ------
p1(0) = p2(0)
p1(1) = p1(1) + 5
p1(2) = p1(2)

p2(0) = p1(0) + 15
p2(1) = p1(1)
p2(2) = p1(2)

Set linie = myBloc.AddLine(p1, p2)


'Textul
p1(0) = p1(0) + 3
p1(1) = p1(1) + 3
p1(2) = p1(2)
Set myText = myBloc.AddText(s, p1, 7)



'Inseram blocul in punctul dat
Dim myBlocRef As AcadBlockReference
Set myBlocRef = ThisDrawing.ModelSpace.InsertBlock(pIn, "sageataNivel", 1#, 1#, 1#, 0)
myBlocRef.Layer = "cote"

End Sub

SEANT
15th Jul 2010, 10:06 am
The routine adds similar geometry to an existing Block. That means any of the Inserts referencing that Block will also include that new geometry.

This may be an option (see below). If each block reference needs a different value (valCota) then that should be set up as an Attribute.


Public Sub BlocCota(pIn As Variant, valCota As Double)

'Pt hasura
Dim outerLoop(0 To 0) As AcadEntity
Dim hasura As AcadHatch
Dim hasuraPattern As AcPatternType
Dim hasuraName As String

'pt restul
Dim myBloc As AcadBlock
Dim linie As AcadLine
Dim myPoly As AcadPolyline
Dim myPoly2 As AcadPolyline
Dim myText As AcadText
Dim colPuncte(0 To 8) As Double
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim s As String
s = CStr(valCota)

'Adaugam blocul la desen
Dim contor As Integer
Dim b As Boolean
Dim vX As Integer
b = True
contor = ThisDrawing.Blocks.Count - 1
Dim ind As Integer
For ind = 0 To contor Step 1
If ThisDrawing.Blocks.Item(ind).Name = "sageataNivel" Then
b = False
vX = ind
Exit For
End If
Next ind

'Linia ____ de inceput
p1(0) = pIn(0)
p1(1) = pIn(1)
p1(2) = pIn(2)

p2(0) = p1(0) + 5
p2(1) = p1(1)
p2(2) = p1(2)

'Triunghiul din stanga
colPuncte(0) = p2(0)
colPuncte(1) = p2(1)
colPuncte(2) = p2(2)

colPuncte(3) = colPuncte(0)
colPuncte(4) = colPuncte(1) + 5
colPuncte(5) = colPuncte(2)

colPuncte(6) = colPuncte(3) - 5
colPuncte(7) = colPuncte(4)
colPuncte(8) = colPuncte(5)

If b = True Then
Set myBloc = ThisDrawing.Blocks.Add(pIn, "sageataNivel")
Set linie = myBloc.AddLine(p1, p2)



Set myPoly = myBloc.AddPolyline(colPuncte)
myPoly.Closed = True

'Linia |
p1(0) = p2(0)
p1(1) = p2(1)
p1(2) = p2(2)

p2(0) = p2(0)
p2(1) = p2(1) + 15
p2(2) = p2(2)

Set linie = myBloc.AddLine(p1, p2)

'Linia ------
p1(0) = p2(0)
p1(1) = p1(1) + 5
p1(2) = p1(2)

p2(0) = p1(0) + 15
p2(1) = p1(1)
p2(2) = p1(2)

Set linie = myBloc.AddLine(p1, p2)


'Textul
p1(0) = p1(0) + 3
p1(1) = p1(1) + 3
p1(2) = p1(2)
Set myText = myBloc.AddText(s, p1, 7)
Else
Set myBloc = ThisDrawing.Blocks.Item(vX)
End If

Set myPoly2 = ThisDrawing.ModelSpace.AddPolyline(colPuncte)
myPoly2.Closed = True

Set outerLoop(0) = myPoly2
hasuraPattern = acHatchPatternTypePreDefined
hasuraName = "SOLID"
Set hasura = ThisDrawing.ModelSpace.AddHatch(hasuraPattern, hasuraName, True)
hasura.AppendOuterLoop (outerLoop)
hasura.Evaluate

'Inseram blocul in punctul dat
Dim myBlocRef As AcadBlockReference
Set myBlocRef = ThisDrawing.ModelSpace.InsertBlock(pIn, "sageataNivel", 1#, 1#, 1#, 0)
myBlocRef.Layer = "cote"

End Sub

10west
26th Jul 2010, 07:01 am
The variable "pIn" have different positional needs I think. One is the insertionpoint with in the block 'definition' (add)

Set myBloc = ThisDrawing.Blocks.Add(pIn, "sageataNivel")

and the other instance at the routines end is it's position within the drawing as a block 'reference' (insert)

Set myBlocRef = ThisDrawing.ModelSpace.InsertBlock(pIn, "sageataNivel", 1#, 1#, 1#, 0)

if Pin was always 0,0 in both calls for 'blockdefinition' and 'blockreference', then no problem,
but when it changes for the selected input, in the second,third,fourth insertion, in the drawing placed 'blockreference', in the second pIn call for insert,
it changes it relative also to it's position within the original call in it's 'definition' when added (essentially redefined in second,third,fourth calls when I assume pIn varies).
Does it displace it the x,y value of the intended insertion of the block 'reference', maybe even x2, the second,third,fourth sequences?

"pIn_Def" and "pIn_Ref" are required, with independant values, I am guessing, and pIn_Def should be final, relative to the block 'definition' itself.
or you add it (define it)once, and never redefine it's 'defintion' with subsequent calls to pIn at second,third,fourth insertion into drawing as a 'reference'