Vítejte !   Přihlášení | Registrace
Hlavní menu
CATIA fórum.cz
Novinky
Seriál CATIA
Obecně o CAD
Novinky ze světa DS
Makra pro CATIA V5
Diskuse
Vytvořit téma
Koncepty
Seznam oblíbených
Soukromé zprávy
Pravidla
Live CHAT
VIP žádost
Základy Catia
Ke stažení
Doporučujeme
Pracovní příležitosti
Reklama a kampaně
O fóru
Nápověda

Změna barvy

Kompletní přehled příspěvků v tématu Změna barvy řazený podle data jejich publikace na fóru.

UživatelPříspěvek
Vaclav

Poslat zprávu | Profil
Datum: 2.3. 2010 | Zobrazeno: 5996x
Konfigurace CATIA:

Text dotazu:
Poskládal jsem makro na generování kusovníku z různých fór. Výsledek snažení je v příloze.
To co jsem zatím nebyl schopen dodělat ani nikde najít je jak obarvit a změnit tlouštku ohraničení tabulky. Prosím pokud někdo ví ať napoví. Díky

makro:

Private Sub CommandButton1_Click()

On Error Resume Next

'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant
Dim Width As Integer
Dim height As Integer
Dim xOffSet As Integer
Dim yOffSet As Integer
Dim XOrig As Integer
Dim YOrig As Integer




'Check that the ActiveDocument is a CATDrawing.
'If not, inform the user and terminate execution.

Set oDocument = CATIA.ActiveDocument

If Right(oDocument.FullName, 10) <> "CATDrawing" Then
MsgBox "This utility must be executed from a within a CATDrawing."
Exit Sub
End If

'Populate the Variables



'On Error GoTo SubError

Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(3)
Set oBackgroundView = oDrawingViews.Item("Background View")
Set oDrawingTables = oBackgroundView.Tables
Set oDrawingView = oDrawingViews.Item(3)

Err.Clear

'Check that the linked document is a product and not a part

Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent


If Err.Number <> 0 Then
MsgBox "The linked model is not a product!", vbExclamation
Exit Sub
End If


Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary")




'get the sheet dimensions so that we can place the bom in the right
'place relative to the drawing border

xOffSet = -12.7
yOffSet = 319.7
Width = oDrawingSheet.GetPaperWidth
height = oDrawingSheet.GetPaperHeight

XOrig = Width + xOffset
YOrig = yOffset


'Scan through the Product Structure of the assembly noteing the quantity of
'Each component. Add one of Each component to a list of the products for
'future use.
Dim n As Integer
Dim SourceText As String
Dim ProductList(50) As Product
Dim Index As Integer
Index = 1

For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)



If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n



'Check to see If a BOM hAs already been created on the Drawing.
'This code will be utilized when updates to the BOM are needed.
'If the BOM table already exists, skip to the code which will
'populate the BOM.
For n = 1 To oDrawingTables.Count
Set oDrawingTable = oDrawingTables.Item(n)
If oDrawingTable.Name = "DrawingBOM" Then
GoTo POPULATEBOM
End If
Next n

'If the table does not exist, create one and label it the same as
'the table name being searched for.

Set oDrawingTable = oDrawingTables.Add(XOrig, YOrig, QtyDict.Count + 1, 5, 3, 5)
oDrawingTable.Name = "DrawingBOM"
oDrawingTable.AnchorPoint = CatTableBottomRight




'Populate the cells of the BOM Table
POPULATEBOM:

Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 1, "ITEM")
Call Dressup_Table_bot(oDrawingTable, oDrawingTable.NumberOfRows, 1, 1, 0)

Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 2, "REQ")
Call Dressup_Table_bot(oDrawingTable, oDrawingTable.NumberOfRows, 2, 1, 0)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 3, "REV")
Call Dressup_Table_bot(oDrawingTable, oDrawingTable.NumberOfRows, 3, 1, 0)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 4, "PART NUMBER")
Call Dressup_Table_bot(oDrawingTable, oDrawingTable.NumberOfRows, 4, 1, 0)
Call oDrawingTable.SetCellString(oDrawingTable.NumberOfRows, 5, "DESCRIPTION")
Call Dressup_Table_bot(oDrawingTable, oDrawingTable.NumberOfRows, 5, 1, 0)


Call oDrawingTable.SetColumnSize(1, 12)
Call oDrawingTable.SetColumnSize(2, 10)
Call oDrawingTable.SetColumnSize(3, 10)
Call oDrawingTable.SetColumnSize(4, 38)
Call oDrawingTable.SetColumnSize(5, 57)
Call oDrawingTable.SetRowSize(oDrawingTable.NumberOfRows, 10)



'Use the list created earlier in order to populate the information
'about Each part in the product structure.

For n = 1 To (oDrawingTable.NumberOfRows - 1)

Call oDrawingTable.SetCellString(n, 1, n + 0)
Call Dressup_Table(oDrawingTable, n, 1, 1, 0)
Call oDrawingTable.SetCellString(n, 2, QtyDict.Item(ProductList(n + 0).PartNumber))
Call Dressup_Table(oDrawingTable, n, 2, 1, 0)
Call oDrawingTable.SetCellString(n, 3, ProductList(n + 0).Revision)
Call Dressup_Table(oDrawingTable, n, 3, 1, 0)
Call oDrawingTable.SetCellString(n, 4, ProductList(n + 0).PartNumber)
Call Dressup_Table(oDrawingTable, n, 4, 1, 0)
Call oDrawingTable.SetCellString(n, 5, " " + ProductList(n + 0).Definition)
Call Dressup_Table(oDrawingTable, n, 5, 2, 0)

Next n

'SubError:
'MsgBox "Failed ", vbCritical, "Stack-Up"


End Sub

Sub Dressup_Table(current_table As DrawingTable, ByVal line_number As Integer, ByVal column_number As Integer, ByVal type_justification As Integer, ByVal bold As Integer)


'-------------------------------
' sort out the justification
'-------------------------------
'
If type_justification = 1 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleCenter
ElseIf type_justification = 2 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleLeft
End If
'
'--------------------------------------
' get the current text
'--------------------------------------
'
Dim current_text As DrawingText
Set current_text = current_table.GetCellObject(line_number, column_number)

'
'------------------------------------
' Set up the current text
'------------------------------------
'
Dim oText As Integer
oText = Len(current_text.Text)
'
' Font Arial
'
current_text.SetFontName 1, oText, "Monospac821 BT"
'
' font height
'
current_text.SetFontSize 1, oText, 3.5

'
' graphical attributes
'


current_text.SetParameterOnSubString catBold, 1, oText, bold
current_text.SetParameterOnSubString catUnderline, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catOverline, 1, oText, 0


End Sub

'-----------------------------------------
' Table dress up For bottom of tabulation
'-----------------------------------------
Sub Dressup_Table_bot(current_table As DrawingTable, ByVal line_number As Integer, ByVal column_number As Integer, ByVal type_justification As Integer, ByVal bold As Integer)


'-------------------------------
' sort out the justification
'-------------------------------
'
If type_justification = 1 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleCenter
ElseIf type_justification = 2 Then
current_table.SetCellAlignment line_number, column_number, CatTableMiddleLeft
End If
'
'--------------------------------------
' get the current text
'--------------------------------------
'
Dim current_text As DrawingText
Set current_text = current_table.GetCellObject(line_number, column_number)

'
'------------------------------------
' Set up the current text
'------------------------------------
'
Dim oText As Integer
oText = Len(current_text.Text)
'
' Font Arial
'
current_text.SetFontName 1, oText, "Monospac821 BT"
'
' font height
'
current_text.SetFontSize 1, oText, 2.5

'
' graphical attributes
'

Dim MyColor As Long

'Encoded RGBA color within long integer (R=255 G=0 B=0 A=255)
MyColor = -16000000
current_text.SetParameterOnSubString catBold, 1, oText, bold
current_text.SetParameterOnSubString catUnderline, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catItalic, 1, oText, 0
current_text.SetParameterOnSubString catOverline, 1, oText, 0
'current_text.SetParameterOnSubString catBold, 0, 0, 1
current_text.SetParameterOnSubString catColor, 1, oText, MyColor

End Sub

Přiložené obrázky:

Jiří Pešek

Poslat zprávu | Profil
[#225] | Publikováno: 02.03. 2010 - 22:29
Ahoj
nevim jestli ti to pomůže:
Dá se změnit barva celé tabulky a potom barva všech fontů.
Sub CATMain()

Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = drawingDocument1.Selection
selection1.Search "Name='Title Block',all"
Set visPropertySet1 = Selection1.VisProperties
visPropertySet1.SetRealColor 255, 0, 0, 0
End Sub
Ing Jan Cinert

Poslat zprávu | Profil
[#227] | Publikováno: 02.03. 2010 - 23:30
Jirka mě předběhl, ale v podstatě jsem chtěl poradit to samé. Vybrat konkrétní tabulku pomocí Selection a pak jí změnit barvu pomocí visProperties. Tento postup funguje prakticky u všech elementů, které mají grafické vlastnosti.
Argumenty metody SetRealColor jsou složky barev RGB modelu (+ inheritance, implicitně 0).
Vaclav

Poslat zprávu | Profil
[#325] | Publikováno: 24.03. 2010 - 10:18
Ahoj,
ještě k selekci tabulky výše:
Nemůžu přijít na to jak vyselektovat tabulku se jménem kterou jsem vytvořil makrem o pár kroků předtím. Tak např. v řádku: *selection1.Search "Name='Title Block',all"*
bych místo 'Title Block' dal proměnou ve které je načten název tabulky. Bohužel tento způsob mi nefunguje.
Existuje ještě jiný způsob? Díky
Ing Jan Cinert

Poslat zprávu | Profil
[#860] | Publikováno: 16.07. 2010 - 21:41
Asi už to není aktuální, ale aby fungovala selekce přes název, musíte element najprve pojmenovat, takže zkuste třeba
vase_tabulka.Name = "My Table"
a potom
selection1.Search "Name='My Table', all"
mělo by to fungovat


Uživatel nepřihlášen

Pro zobrazení obsahu stránky / provedení akce (vytvoření nového téma, napsání odpovědi do diskuse apod.) musíte být přihlášeni.