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
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