Hi @robmit_arm . I optimized your code and solved your 3 problems. I hope this is what you wanted. Solution to question 3 lines 54-58.
Sub main()
'initial release
'v0.9 / 2023-11-15
Dim oInvApp As Inventor.Application = ThisApplication
'part veryfication
If oInvApp.ActiveDocumentType <> kPartDocumentObject Then
MessageBox.Show("uruchomić z poziomu części", "UWAGA", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
'part definition
oPartDoc = oInvApp.ActiveDocument
'component definition
Dim oPartDef As PartComponentDefinition = oPartDoc.ComponentDefinition
'drilled color definition / wiercona prosta, przejściowa
Dim sColor(7) As String
Dim oLanguage As String = oInvApp.LanguageName
If oLanguage = "English" Then
oAssetLib = oInvApp.AssetLibraries.Item("Autodesk Appearance Library")
sColor = {"Orange", "Sky Blue Medium", "Dark Green", "Violet", "Magenta", "Anodized - Blue", "Orange-Red", "Cyan"}
Else If oLanguage = "Polski" Then
oAssetLib = oInvApp.AssetLibraries.Item("Biblioteka wyglądu renderingu Autodesk")
sColor = {"Pomarańczowa", "Średniobłękitna", "Ciemnozielona", "Fioletowa", "Fioletowe", _
"Anodowany — niebieski", "Pomarańczowo-czerwona", "Cyjan" }
Else : Exit Sub
End If
Dim oTM As Transaction = oInvApp.TransactionManager.StartTransaction(oPartDoc, "ChangeColorHoles")
Try
Dim oLocalAsset1 As Asset = GetAssets(sColor(0))
Dim oLocalAsset2 As Asset = GetAssets(sColor(1))
Dim oLocalAsset3 As Asset = GetAssets(sColor(2))
Dim oLocalAsset4 As Asset = GetAssets(sColor(3))
Dim oLocalAsset5 As Asset = GetAssets(sColor(4))
Dim oLocalAsset6 As Asset = GetAssets(sColor(5))
Dim oLocalAsset7 As Asset = GetAssets(sColor(6))
Dim oLocalAsset8 As Asset = GetAssets(sColor(7))
For Each oHoleFeature As HoleFeature In oPartDef.Features.HoleFeatures
If oHoleFeature.Tapped <> True Then
Dim sInfoName As String = String.Empty
Try : sInfoName = oHoleFeature.ClearanceInfo.FastenerType : Catch : End Try
If sInfoName.Contains("kołek stalowy DIN 6325 / DIN 7979") Then
oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(7)) ' dowel pin hole / otwór pod kołek
Else
Select Case oHoleFeature.HoleType
Case 21505 :
If oHoleFeature.IsClearanceHole Then
oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(6)) ' drilled / wiercona prosta, przejściowa
Else
oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(0)) ' drilled / wiercona prosta, przejściowa
End If
Case 21506 : oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(1)) ' countersunk / pogłębienie stożkowe
Case 21507 : oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(2)) ' counterbore / pogłębienie walcowe
Case 21508 : oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(3)) ' spotfaced / pogłębienie czołowe
End Select
End If
Else ' threated hole definition
Dim ThreadInfo As Object = oHoleFeature.TapInfo()
If Not ThreadInfo.Metric() Then
oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(6))
Continue For
End If
If ThreadInfo.RightHanded() Then ' right hand
If Left(ThreadInfo.ThreadDesignation(), 1) = "M" Then
Dim nominal As String = ThreadInfo.NominalSize()
Dim pitch As Double
Dim pitch_st As String = ThreadInfo.ThreadDesignation()
Dim Separators() As Char = {"x"c }
Words = pitch_st.Split(Separators)
pitch = Val(Words(1))
Select Case Double.Parse(nominal) ' pitch size definition
Case 2, 2.5, 3, 4, 5, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 27, 30, 33
Select Case pitch
Case 0.4, 0.45, 0.5, 0.7, 0.8, 1, 1.25, 1.5, 1.75, 2 , 2.5 , 3, 3.5
oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(4))
Case Else
oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(5))
End Select
End Select
Else
oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(6))
End If
Else
oHoleFeature.Appearance = oPartDoc.Assets.Item(sColor(6))
End If
End If
Next
'pattern definition
Dim oFeatures As PartFeatures = oPartDoc.ComponentDefinition.Features
'rectangular pattern definition
For Each RectPattern As RectangularPatternFeature In oFeatures.RectangularPatternFeatures
RectPattern.Appearance = RectPattern.Definition.ParentFeatures(1).Appearance
Next
'circular pattern definition
For Each CirPattern As CircularPatternFeature In oFeatures.CircularPatternFeatures
CirPattern.Appearance = CirPattern.Definition.ParentFeatures(1).Appearance
Next
'mirror definition
For Each MirrPattern As MirrorFeature In oFeatures.MirrorFeatures
For i As Integer = 1 To MirrPattern.Faces.Count
For Each oFeat As PartFeature In MirrPattern.Definition.ParentFeatures
For j As Integer = 1 To oFeat.Faces.Count
If oFeat.Faces(j).Evaluator.Area = MirrPattern.Faces(i).Evaluator.Area Then
MirrPattern.Faces(i).Appearance = oFeat.Faces(j).Appearance
End If
Next j
Next
Next i
Next
'sketch driven Pattern
For Each SketchPattern As SketchDrivenPatternFeature In oFeatures.SketchDrivenPatternFeatures
SketchPattern.Appearance = SketchPattern.Definition.ParentFeatures(1).Appearance
Next
Catch
oTM.Abort()
Exit Sub
End Try
oTM.End()
End Sub
'part definition
Dim oPartDoc As PartDocument
'asset library definition
Dim oAssetLib As AssetLibrary
Private Function GetAssets(ByVal sName As String) As Asset
Try : oLocalAsset8 = oPartDoc.Assets(sName)
Catch : oLocalAsset8 = oAssetLib.AppearanceAssets(sName).CopyTo(oPartDoc)
End Try
End Function
