Jump to content

How to insert block with vba???


firavolla

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 2 weeks later...

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'

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...