TheSwamp

Code Red => VB(A) => Topic started by: Yosso on March 08, 2017, 06:07:09 PM

Title: ACAD 2017 - embedded images and perusing the drawing via OBDBX
Post by: Yosso on March 08, 2017, 06:07:09 PM
Good afternoon all!

I'm still not comfortable enough with NET to work up solutions, so I've been muddling about with VBA.

Converted some code and merged some modules work get the attached workbook going...

Works great, but struggles with embedded raster images.  Pretty sure the CAD department is embedding using Raster Design, but I should verify.

The problematic file contains 0510 in the name...hence the debugging code.

I've managed to use some wonky error trapping to resume and pull the attributes from two of the three drawings which contain embedded raster images, but the last drawing is giving me fits, so I'd like to do it "right"

(Probably need to use c#...)

Code below and the actual workbook is attached. 

Using vanilla 2017 on my box.

Code - vb.net: [Select]
  1. ' Determine if the chosen block is present in the drawing
  2. For Each oBlock In oDBX.Blocks
  3.     If UCase(oBlock.Name) = UCase(gsBlockName) Then
  4.         BlkExist = True
  5.         If sPath Like "*0510*" Then
  6.             ' Debug.Print oBlock.Name
  7.             Stop
  8.         End If
  9.         Exit For
  10.     End If
  11. Next oBlock
  12.  
  13. ' Open each layout
  14. ' Look for the title sheet block
  15. ' If the block if found extract the attributes
  16. If BlkExist Then
  17.     BlkFound = False
  18.     Set oLayouts = oDBX.Layouts
  19.     For Each oLayout In oLayouts
  20.         sngBlkCount = 0 ' reset the counter for each layout
  21.         ' If oLayout.Name = "0510" Then Stop
  22.         If oLayout.Name <> "Model" Then ' Paper Space
  23.             ' To Do : Add status bar update
  24.             ' Place the folder, file and layout name
  25.             ' into the Excel worksheet
  26.             ws.Cells(glRowCounter, 1) = fName
  27.             ws.Cells(glRowCounter, 2) = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
  28.             With ws.Cells(glRowCounter, 3)
  29.                 .NumberFormat = "@"
  30.                 .Value = oLayout.Name
  31.             End With
  32.             Set oBlock = oLayout.Block
  33.             For Each oEnt In oBlock
  34. '                If oLayout.Name = "0510" And (TypeOf oEnt Is AcadBlockReference) Then
  35. '                     Debug.Print oEnt.Effective.Name & " < - > " & oEnt.Name
  36. '                     'Stop
  37. '                     'Debug.Print oEnt.Name
  38. '                End If
  39.                 ' On Error Resume Next
  40.               ' Raster image editing
  41.               ' http://forums.augi.com/showthread.php?88338-Remove-Raster-Image-VBA-Code
  42. '                If TypeOf oEnt Is AcadRasterImage Then
  43. '                    Stop
  44. '                End If
  45.                 ' If Not (TypeOf oEnt Is AcadRasterImage Or TypeOf oEnt Is AcadExternalReference) Then
  46.                     If TypeOf oEnt Is AcadBlockReference Then  ' we have a block
  47.                         Set oBlockRef = oEnt
  48.                         If oLayout.Name = "0510" Then
  49.                             ' Stop
  50.                             Debug.Print oBlockRef.EffectiveName & "-" & oBlockRef.ObjectName
  51.                         End If
  52.                        
  53.                         If oBlockRef.IsDynamicBlock Then
  54.                             BlkEffName = oBlockRef.EffectiveName
  55.                         Else
  56.                             BlkEffName = oBlockRef.Name
  57.                         End If
  58.                        
  59.                         If BlkEffName = UCase(gsBlockName) Then ' We have found a matching block
  60.                             ' Place the block name in the Excel worksheet
  61.                             ws.Cells(glRowCounter, 4) = BlkEffName
  62.                             ' Place the current entity in a block reference
  63.                             Set oBlockRef = oEnt
  64.                             ' Increment the block counter - should only be a single
  65.                             ' instance of the title data block in the layout
  66.                             sngBlkCount = sngBlkCount + 1
  67.                             ' Does the block contain attributes?
  68.                             If oBlockRef.HasAttributes Then
  69.                                 ' Extract the attributes from the block
  70.                                 ' Parse the block's attributes
  71.                                 blkAtts = oEnt.GetAttributes
  72.                                 Call ExtractAtts(blkAtts, ws, glRowCounter, glColStart)
  73.                             End If
  74.                             ' Debug.Print oBlockRef.Name
  75.                         End If
  76.                     End If      ' AcadBlockReference
  77.                 ' End If          ' AcadExternalReference
  78.                 'End If ' xref
  79.             Next ' oEnt
  80.             If sngBlkCount = 0 Then ' block not found
  81.                 ws.Cells(glRowCounter, 4) = "BLOCK NOT FOUND!"
  82.             End If
  83.             ' Increment the Excel rowcounter
  84.             glRowCounter = glRowCounter + 1
  85.         End If
  86. Return_xref:
  87.     Next ' oLayout
  88. End If
  89.  
  90. Return_Here:
  91.  
  92. Resume_Cleanup:
  93.  
  94. Exit Sub ' before error catch
  95.  
  96. Error_Catch:
  97. Select Case Err.Number
  98. Case -2147467259
  99.     MsgBox "The drawing """ & fFile & """ is open in this drawing session." & vbCrLf & _
  100.            "Please close and try again....", , "ObjectDBX Error"
  101.     Err.Clear
  102.     glRowCounter = glRowCounter + 1
  103.     Resume Return_Here
  104. Case -2147417851
  105. '    MsgBox "The drawing """ & fFile & """ has an embeded object." & vbCrLf & _
  106. '           "Unable to extract blocks at this time....", , "ObjectDBX Error"
  107.     Err.Clear
  108.     glRowCounter = glRowCounter + 1
  109.     Resume Return_xref
  110.  
  111. Case Else
  112.     MsgBox Err.Description & " - Error Number: " & Err.Number, , "Unhandled error"
  113.     Err.Clear
  114.     Resume Resume_Cleanup
  115. End Select
  116.  
  117. End Sub
  118.  
  119.