how to detect existing block and react to it?

[comcu]

Hi,

 

I am having a little problem with code i am working on.

 

i am creating a block, adding attributes then getting the user to pick 2points from this the code inserts the block then adds the width and height to the attributes.

 

the problem is that everytime i run it it keeps adding attributes so if i run it 5times i will have 5 of the same attributes in the same block.

 

I think the simpliest way is to say if block exists dont got to the module that creates the block go to the module that adds the values to the attributes.

 

 

If ThisDrawing.BlockReference.MyBlock = True then 

Call AddValuesToAttributes ' module name

else 

call CreateBlock ' module name

 

I know the code above does not work my intention is to clarify (or at least try).

 

Thanks you for taking the time to help,

 

Cheers,

 

Col.

[BIGAL]

Sounds like your sequence of events is wrong inside your repeat loop and its not resetting to recognise the new block created.

[comcu]

Sounds like your sequence of events is wrong inside your repeat loop and its not resetting to recognise the new block created.

 

BIGAL,

 

I dont think it is wrong sequence i just dont thing i have told it to stop creating the block if one exists?

 

Public OpWidTrue As Long
Public OpHghtTrue As Long
Public OpWid As Long
Public OpHght As Long
Public OpStartX As Long
Public OpStartY As Long
Public XOffset As Double
Public YOffset As Double
Public LayText As String
Public GlassHght As Double
Public GlassWid As Double
Public startPnt As Variant
Public endPnt As Variant
Public startPoint(0 To 2) As Double, endPoint(0 To 2) As Double
Public TextHghtTrue
Public GlassRef As String
Public GlassSpec As String




Sub seedVariablesCreateGlassAtt()

LayText = "Text__HADRIAN"
XOffset = UFcreateGlassAtt.TxBxXOffset
YOffset = UFcreateGlassAtt.TxBxYOffset
TextHghtTrue = UFcreateGlassAtt.TxBxTHght * UFcreateGlassAtt.TxBxVPScale
GlassRef = UFcreateGlassAtt.TxBxRef
GlassSpec = UFcreateGlassAtt.TxBxSpec
End Sub

Sub RunProjGlassCalc()
UFcreateGlassAtt.Show
End Sub

 

 Sub CreateAttBlock()


 Dim blockObj As AcadBlock
   Dim insertionPnt1(0 To 2) As Double
   Dim insertionPnt2(0 To 2) As Double
       Dim insertionPnt3(0 To 2) As Double
       Dim insertionPnt4(0 To 2) As Double
   Dim alignmentPoint1(0 To 2) As Double
   Dim alignmentPoint2(0 To 2) As Double
   Dim alignmentPoint3(0 To 2) As Double
   Dim alignmentPoint4(0 To 2) As Double
   
   Set blockObj = ThisDrawing.Blocks.Add(insertionPnt1, "GlassCalc")

   ' Define the attribute definition
   Dim attributeObj As AcadAttribute
   Dim height As Double
   Dim mode As Integer
       Dim prompt1 As String
       Dim tag1 As String
       Dim value1 As String
               Dim prompt2 As String
               Dim tag2 As String
               Dim value2 As String
                   height = TextHghtTrue
                   mode = acAttributeModeVerify ' acattributemodeinvisible __ switch between these for visible and invisible

       tag1 = "GlassRef"
       prompt1 = "What is the Glass Ref?"
       value1 = GlassRef
       insertionPnt1(0) = TextHghtTrue / 5: insertionPnt1(1) = TextHghtTrue * 3: insertionPnt1(2) = 0
       alignmentPoint1(0) = TextHghtTrue / 5: alignmentPoint1(1) = TextHghtTrue * 3: alignmentPoint1(2) = 0
       
           tag2 = "GlassSpec"
           prompt2 = "What is the Glass SPEC?"
           value2 = GlassSpec
          insertionPnt2(0) = TextHghtTrue / 5: insertionPnt2(1) = TextHghtTrue * 1.5: insertionPnt2(2) = 0
          alignmentPoint2(0) = TextHghtTrue / 5: alignmentPoint2(1) = TextHghtTrue * 1.5: alignmentPoint2(2) = 0

           tag3 = "GlassWid"
           prompt3 = "What is the Glass Width?"
           value3 = GlassWid
          insertionPnt3(0) = TextHghtTrue / 5: insertionPnt3(1) = 0: insertionPnt3(2) = 0
          alignmentPoint3(0) = TextHghtTrue / 5: alignmentPoint3(1) = 0: alignmentPoint3(2) = 0
          
                      tag4 = "GlassHght"
           prompt4 = "What is the Glass Height?"
           value4 = GlassHght
          insertionPnt4(0) = 0#: insertionPnt4(1) = 0: insertionPnt4(2) = 0
          alignmentPoint4(0) = TextHghtTrue * 4.5: alignmentPoint4(1) = 0: alignmentPoint4(2) = 0
          
          
          
   ' Create the attribute definition on the block

       Set attributeObj = blockObj.AddAttribute(height, mode, prompt1, insertionPnt1, tag1, "Ref:" & value1)
            attributeObj.Alignment = acAlignmentCenter
            attributeObj.TextAlignmentPoint = alignmentPoint1
            attributeObj.Alignment = acAlignmentBottomLeft
            'attributeObj.StyleName = "APABEM"

           Set attributeObj = blockObj.AddAttribute(height, mode, prompt2, insertionPnt2, tag2, "Spec: " & value2)
            attributeObj.Alignment = acAlignmentCenter
            attributeObj.TextAlignmentPoint = alignmentPoint2
           'attributeObj.StyleName = "APABEM"
           attributeObj.Alignment = acAlignmentBottomLeft
           
           Set attributeObj = blockObj.AddAttribute(height, mode, prompt3, insertionPnt3, tag3, value3 & " x ")
            attributeObj.Alignment = acAlignmentCenter
            attributeObj.TextAlignmentPoint = alignmentPoint3
           'attributeObj.StyleName = "APABEM"
           attributeObj.Alignment = acAlignmentBottomLeft
           
                       Set attributeObj = blockObj.AddAttribute(height, mode, prompt4, insertionPnt4, tag4, value4)
            attributeObj.Alignment = acAlignmentCenter
            attributeObj.TextAlignmentPoint = alignmentPoint4
           'attributeObj.StyleName = "APABEM"
           attributeObj.Alignment = acAlignmentBottomLeft

   ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & "GlassCalc" & vbCr
      
InsertBlock
  ' ZoomAll
   
   
 End Sub

 

Sub InsertBlock()

   ' Define the block
'Dim MyAttTextStr As String
   Dim blockObj As AcadBlock
   Dim insertionPnt(0 To 2) As Double
   insertionPnt(0) = 0
   insertionPnt(1) = 0
   insertionPnt(2) = 0
   'Set blockObj = ThisDrawing.Blocks.Add _
                    '(insertionPnt, "LEVEL4_ATTBLOCK")
                       '(insertionPnt, "APA013")

Dim MyInsertPt As Variant
'MyInsertPt = ThisDrawing.Utility.GetPoint(, vbCr & "Pick insertion point: ")
MyInsertPt = startPnt
   ' Insert the block
   Dim blockrefobj As AcadBlockReference
   
   Myblockrefobj = "GlassCalc"
   
                   Set blockrefobj = ThisDrawing.ModelSpace.InsertBlock _
               (MyInsertPt, Myblockrefobj, 1#, 1#, 1#, 0)
   
GlassRef = GlassRef + 1
   
   'UFcreateGlassAtt.Show
   
   GetPointsFromUser
   
End Sub

 

I think i need to write code that if the block exists it only inserts the block, it does not create it?

 

Cheers,

 

Col.

[comcu]

Hi,

 

Played about with it a bit and this seems to work

 

 Sub BlockPresentDetector()

 Dim blockObj As AcadBlock

   'Set blockObj = ThisDrawing.Blocks.Add(insertionPnt1, "GlassCalc")
On Error GoTo ErrorManager
   Set blockObj = ThisDrawing.Blocks("A4 Portrait")
   
   MsgBox ("block exists")
   
   End
ErrorManager:
   
   MsgBox ("Block Does not exist")
   
 End Sub

 

 

I will incoporate it into the code i have and use it to control the flow of the code.

 

Do you know a better way of doing it as it seems a bit of a hash job?

 

Cheers,

 

Col