Hallo
Ich habe mir mal vor einiger Zeit ein Makro geschrieben mit dem ich die Farbe von einem Drafting ändere und diese dann als DXF und DWG Speicher.
Jetzt braucht ein Kunde aber die Masszahlen in Rot.
Wie kann ich die Masszahl im Makro ansprechen und die Farbe ändern.
Language="VBSCRIPT"
Sub CATMain()
folderinput = InputBox ("Bitte den Ursprungsordner eingeben","Eingabe","D:\Daten\in\",500,1000)
folderoutput = InputBox ("Bitte das Zielordner eingeben","Eingabe","D:\Daten\out\",500,1000)
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderinput)
Set fc = f.Files
For Each f1 in fc
Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim document1 As Document
PFADEINGABE = folderinput & f1.name
Set document1 = documents1.Open(PFADEINGABE)
Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument
drawingDocument1.Standard = 1
Dim drawingSheets1 As DrawingSheets
Set drawingSheets1 = drawingDocument1.Sheets
Dim drawingSheet1 As DrawingSheet
Set drawingSheet1 = CATIA.ActiveWindow
drawingSheet1.Activate
Set drawingDocument1 = CATIA.ActiveDocument
Set specsAndGeomWindow1 = CATIA.ActiveWindow
Dim selection1 As Selection
Set selection1 = drawingDocument1.Selection
selection1.Search "(Dashed=1 & Weight=0,1mm),all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 0,125,255,0
visPropertySet1.SetLayer catVisLayerBasic, 0
selection1.Clear
selection1.Search "CATDrwSearch.CATEarlyGenShape,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 0,255,255,0
visPropertySet1.SetLayer catVisLayerBasic, 7
selection1.Clear
selection1.Search "CATDrwSearch.DrwText,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 0,0,0,0
visPropertySet1.SetLayer catVisLayerBasic, 1
selection1.Clear
selection1.Search "CATDrwSearch.DrwDimension,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 0,255,255,1
visPropertySet1.SetLayer catVisLayerBasic, 2
selection1.Clear
selection1.Search "Dashed=3,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 255,255,0,1
visPropertySet1.SetLayer catVisLayerBasic, 3
selection1.Clear
selection1.Search "Dashed=4,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 255,0,255,1
visPropertySet1.SetLayer catVisLayerBasic, 4
selection1.Clear
selection1.Search "Weight=0,5mm,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 255,0,0,1
visPropertySet1.SetLayer catVisLayerBasic, 5
selection1.Clear
selection1.Search "Weight=0,35mm,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 0,255,0,1
visPropertySet1.SetLayer catVisLayerBasic, 6
selection1.Clear
selection1.Search "Weight=0,10mm,all"
Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 255,255,0,1
visPropertySet1.SetLayer catVisLayerBasic, 7
selection1.Clear
Zeichenlaenge = LEN (f1.name)
Zeichenlaenge = Zeichenlaenge - 11
Ausgabe1 = Mid (f1.name, 1, Zeichenlaenge)
PFADAUSGABE = folderoutput & Ausgabe1 & ".DXF"
drawingDocument1.ExportData PFADAUSGABE, "dxf"
PFADAUSGABE = folderoutput & Ausgabe1 & ".DWG"
drawingDocument1.ExportData PFADAUSGABE, "dwg"
Dim specsAndGeomWindow1 As Window
Set specsAndGeomWindow1 = CATIA.ActiveWindow
specsAndGeomWindow1.Close
Set drawingDocument1 = CATIA.ActiveDocument
drawingDocument1.Close
s = s & f1.name
s = s & vbCrLf
Next
MsgBox "fertig !" & vbCrLf & s
End Sub
Gruß
Berges
------------------
KOBUE
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
