Hallo Bernd,
Danke das war der Fehler habe das ganze jetzt eingebaut funktioniert bestens.
Da ich ja nicht soviel plan vom Scripten habe hier mal der ganze Code, gibt es da noch Vorscläge zur vereinfachung oder verbesserung?
Code:
-------------------------------------------------------------------------
Sub CATMain()
Dim objSel As Selection
Dim objPartDoc As PartDocument
Dim objHole, objPattern, objChamfer, objFillet, objThread As Variant
Dim i As Integer
Set objPartDoc = CATIA.ActiveDocument
Set objSel = objPartDoc.Selection
objSel.Clear
objSel.Search "CATPrtSearch.Hole,all"
'Bohrungen----------------------------------------------
If objSel.Count > 0 Then
For i = 1 To objSel.Count
Set objHole = objSel.Item(i).Value
If objHole.ThreadingMode = catThreadedHoleThreading Then
objHole.Name = objHole.HoleThreadDescription.Value & " - " & objHole.ThreadDepth.Value & "mm tief; Kernloch: " & objHole.Diameter.Value & "mm Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
ElseIf objHole.Diameter.MaximumTolerance > 0 And objHole.Diameter.MinimumTolerance = 0 Then
objHole.Name = "Ø" & objHole.Diameter.Value & "H7 Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
Else objHole.Name = "Ø" & objHole.Diameter.Value & "mm Tiefe: " & objHole.BottomLimit.Dimension.Value & "mm"
End If
If objHole.Type = catCounterDrilledHole Then
If objHole.HeadDiameter.MaximumTolerance > 0 And objHole.HeadDiameter.MinimumTolerance = 0 Then
objHole.Name = "Ø" & objHole.HeadDiameter.Value & "H7 Tiefe: " & objHole.HeadDepth.Value & "mm"
End If
End If
Next
End If
objSel.Clear
objSel.Search "CATPrtSearch.Pattern,all"
If objSel.Count > 0 Then
For i = 1 To objSel.Count
Set objPattern = objSel.Item(i).Value
If Left(objPattern.Name, 1) = "#" Then 'wenn # dann nichts ändern
Else
objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name
End If
Next
End If
'Einfärben Standartbohrung--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole & Name=Ø*)"
objSel.VisProperties.SetRealColor 125, 0, 50, 1
'Muster---------------------------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von Ø*),all"
objSel.VisProperties.SetRealColor 125, 0, 50, 1
'Einfärben der Passung H7--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole & Name=Ø*H7*)"
objSel.VisProperties.SetRealColor 255, 0, 0, 1
'Muster---------------------------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von Ø*H7*),all"
objSel.VisProperties.SetRealColor 255, 0, 0, 1
'Einfärben der Feingewinde--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.ThreadDescription = M*x*),all"
objSel.VisProperties.SetRealColor 226, 172, 8, 1
'Muster---------------------------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von M*x*),all"
objSel.VisProperties.SetRealColor 226, 172, 8, 1
'Einfärben der Normalgewinde-----------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.ThreadDescription = M* & CATPrtSearch.Hole.ThreadDescription = M* & CATPrtSearch.Hole.ThreadDescription!=M*x*),all"
objSel.VisProperties.SetRealColor 255, 210, 10, 1
'Muster--------------------------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von M* & CATPrtSearch.Pattern.Name!=Muster von M*x*),all"
objSel.VisProperties.SetRealColor 255, 210, 10, 1
'Einfärben der Rohrgewinde--------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Hole.ThreadDescription = G*),all"
objSel.VisProperties.SetRealColor 197, 133, 6, 1
'Muster-------------------------------------------------
objSel.Clear
objSel.Search "(CATPrtSearch.Pattern.Name = Muster von G*),all"
objSel.VisProperties.SetRealColor 197, 133, 6, 1
End sub
------------------
MfG
Hendrik
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP