Tracking Un-ballooned components in Drawing?

[Yadow]

Hey guys,

I wonder if anyone might know how to ether highlight or print out compontents that does not have a balloon attached to them already?

I am fairly new to Programming, but learning to create my own Macros. If I find a solution I will post it here :).

Best Wishes,
Tobias.

[MechMachineMan]

Option Compare Text

Class DwgCheck
	Shared oDoc As Document
	Shared oSheet As Sheet
	Shared oProgressbar As ProgressBar
	Shared oTextSave As String = "C:\Users\Public\Documents\iLogic Buffer File.txt" 
	Shared oWrite As Object 
	Shared oStr1 As String
	Shared oStr2 As String
	Shared oStr3 As String
	Shared oStr4 As String
	Shared oStr5 As String
	Shared oStr6 As String


	Shared Sub Main()
		Dim oPartsList As PartsList
		Dim oRow As PartsListRow
		Dim oCell As PartsListCell
		oWrite = System.IO.File.CreateText(oTextSave)
		oWrite.WriteLine("Parts List Content Check")
		oDoc = ThisApplication.ActiveDocument 
		oProgressBar = ThisApplication.CreateProgressBar(False, oDoc.Sheets.Count, "Pre-Issue Drawing Check Status")
		
		For j = 1 To oDoc.Sheets.Count
			oSheet = oDoc.Sheets.Item(j)
			oSheet.Activate
			
			oProgressBar.Message = ("Translating Data. Current Sheet: " & j & "/" & oDoc.Sheets.Count & vbLf & oSheet.Name)
			oProgressBar.UpdateProgress
			
			'Clear the string variables
			oStr1 = ""
			oStr2 = ""
			oStr3 = ""
			oStr4 = ""
			oStr5 = ""
			oStr6 = ""
			
			Call CheckDims()
			Call CheckSymbols()
			Call CheckPartsLists()
			
			Try
				If oStr1 = "" And oStr2 = "" And oStr3 = "" And oStr4 = "" And oStr5 = "" And oStr6 = ""
				Else
				
					oWrite.WriteLine("")
					oWrite.WriteLine("#-------" & oSheet.Name)
	
					If oStr1 <> ""
						oWrite.WriteLine("## Balloons: " & oStr1)
					End If
					
					If oStr2 <> ""
						oWrite.WriteLine("## Custom Line: " & oStr2)
					End If
	
					If oStr4 <> ""
						oWrite.WriteLine("## Static Line: " & oStr4)
					End If
	
					If oStr3 <> ""
						oWrite.WriteLine("## Descrip: " & oStr3)
					End If
					
					If oStr5 <> ""
						oWrite.WriteLine("## : " & oStr5)
					End If
					
					If oStr5 <> ""
						oWrite.WriteLine("## : " & oStr6)
					End If
				End If
			Catch
				oWrite.WriteLine()
				oWrite.WriteLine("FAILED: " & oSheet.Name & " - " & oDoc.FullFileName)
				oWrite.WriteLine()
				Continue For
			End Try		
		Next'Sheet
		
		oProgressBar.Close
		oWrite.Close()
		Process.Start ("Notepad.exe",oTextSave)
	End Sub
	
	Sub CheckDims()
		Dim oDims As DrawingDimensions
		oDims = oSheet.DrawingDimensions
		
		If oDims.Count = 0
				oStr5 = AddToString(oStr5, " and ", "Missing Dims!")
		End If
		
		For Each oDim As DrawingDimension In oDims
			If oDim.Attached = False
				oStr5 = AddToString(oStr5, " and ", "Broken!")
				Exit For
			End If
		Next
	End Sub
	
	Sub CheckSymbols()
		Dim oSketched As SketchedSymbol
		For Each oSketched In oSheet.SketchedSymbols
			For Each oTextBox In oSketched.Definition.Sketch.TextBoxes
				If oTextBox.Text = ""
					oStr6 = AddToString(oStr6, " and ", "Blank Sketched TextBox Found!")
					Exit For
				End If
			Next
		Next
	End Sub
	
	Sub CheckPartsLists()
		If oSheet.PartsLists.Count = 0
			Exit Sub
		End If
		
		For j = 1 To oSheet.PartsLists.Count
			oPartsList = oSheet.PartsLists.Item(j)	
			
			For Each oRow In oPartsList.PartsListRows
				
				'Check Balloons
				If oRow.Ballooned = False
					oStr1 = AddToString(oStr1, ", ", oRow.Item("LINE").Value)
				End If
						
				'Check Custom Rows
				If oRow.Custom = True
					oStr2 = AddToString(oStr2, ", ", oRow.Item("LINE").Value)
				End If
				
				'Check 1/8" plate, A569, UNF, or gauge plate
				If oRow.Item("DESCRIPTION").Value Like "*A569*" Or _
					oRow.Item("DESCRIPTION").Value Like "*Gr*.*5*" Or _
					oRow.Item("DESCRIPTION").Value Like "*UNF*" Or _
					oRow.Item("DESCRIPTION").Value Like "*PL. 1/8*"
					
					oStr3 = AddToString(oStr3, "vblf", oRow.Item("LINE").Value & ") " & oRow.Item("DESCRIPTION").Value)
				End If	
	
				If oRow.ReferencedRows.Item(1).BOMRow.ComponentDefinitions.Item(1).Type() = ObjectTypeEnum.kVirtualComponentDefinitionObject
					'Do nothing
				Else
					If Not oRow.Item("DESCRIPTION").Value.Length = oRow.ReferencedRows.Item(1).BOMRow.ComponentDefinitions.Item(1).Document.PropertySets.Item("Design Tracking Properties").Item("Description").Value.Length
						oStr4 = AddToString(oStr4, ", ", oRow.Item("LINE").Value)
					End If
					'MsgBox(oRow.Item("ITEM").Value)
				End If
			Next 'Row
		Next 'PartsLists
	End Sub
	
	
	Function AddToString(oStorageString As String,oSeparator As String, oDetail As String) As String
		If oStorageString = ""
			oStorageString = oDetail
		Else
			If oSeparator Like "vblf"
				oStorageString = oStorageString & vbLf & oDetail
			Else
				oStorageString = oStorageString & oSeparator & oDetail
			End If
		End If
		
		Return oStorageString
	End Function
	
	Function DocNameWExt(oName As String)
		oPos = Len(oName) - InStrRev(oName, "\", -1) 'Position left Right = Length of string - Position of "\" from right side
		oNameWExt = Right(oName, oPos)               'Name with Extension = Everything to the right of the oPos
		Return oNameWExt
	End Function
	
End Class

[Yadow]

Thank you so much for the code 🙂 Is this for iLogic? Is there any way I could ask you for a translation of this code into VBA-code?

If not then I´ll take this and learn what I can from it. 

Many thanks once again!

[MechMachineMan]

The main differences between vba and vb.net (which iLogic is based on) are:

Vba needs to use "On Error Resume" clauses whereas vb.net uses the more
intuitive try/catch.

Vba requires common variable type assignments to be preceded by "Set".

Other than that, there might be a few small things, but changing these 2
things could get it completely working for you.