font size with color 1

[Durga Abishek]

please suggest changes in the macro that identifies dimensions and change colors with font and also this have to identity each letter

Option Explicit

Private Const OTHERCOLOR = "0, 0, 0"

Sub CATMain()

Dim txts As Collection
Set txts = getShowTxts()
If txts Is Nothing Then Exit Sub

Dim colorMap As Variant
colorMap = initColorMap()

Dim sizeDic As Object
Set sizeDic = groupBySize(txts)

Call execChangeColor(sizeDic, colorMap)

MsgBox "Done"
End Sub

Private Sub execChangeColor( _
ByVal group As Object, _
ByVal colorMap As Variant)

Dim sel As selection
Set sel = CATIA.ActiveDocument.selection

Dim vis As VisPropertySet
Set vis = sel.VisProperties

CATIA.HSOSynchronized = False

Dim key As Variant ' Long
Dim rgbAry As Variant
Dim rgbTxt As String
Dim dt As DrawingText
For Each key In group.keys

If UBound(colorMap) > key Then
'In colormap
rgbTxt = colorMap(key)
Else
'other
rgbTxt = OTHERCOLOR
End If

rgbAry = Split(rgbTxt, ",")

sel.Clear
For Each dt In group(key)
sel.Add dt
Next

Call vis.SetRealColor( _
CLng(rgbAry(0)), _
CLng(rgbAry(1)), _
CLng(rgbAry(2)), _
1)

Next

sel.Clear

CATIA.HSOSynchronized = True

End Sub

'return dic(txtsize,lst(drawtxt))
Private Function groupBySize( _
ByVal txts As Collection) _
As Object

Dim dic As Object
Set dic = initDic()

Dim dt As DrawingText
Dim prop As DrawingTextProperties
Dim key As Long
Dim lst As Collection

For Each dt In txts
Set prop = dt.TextProperties
key = CLng(prop.FONTSIZE)

If dic.Exists(key) Then
Call dic(key).Add(dt)
Else
Set lst = New Collection
lst.Add dt
Call dic.Add(key, lst)
End If
Next

Set groupBySize = dic

End Function

Private Function initDic() _
As Object

Set initDic = CreateObject("Scripting.Dictionary")

End Function

Private Function getShowTxts() _
As Collection

Set getShowTxts = Nothing

Dim sel As selection
Set sel = CATIA.ActiveDocument.selection

CATIA.HSOSynchronized = False

sel.Clear
sel.Search "CATDrwSearch.DrwText,all"

CATIA.HSOSynchronized = True

If sel.Count < 1 Then
MsgBox "Text not found"
Exit Function
End If

Dim lst As Collection
Set lst = New Collection

Dim i As Long
For i = 1 To sel.Count
lst.Add sel.Item2(i).value
Next

sel.Clear
Set getShowTxts = lst

End Function

'Sample that changes color with text size
'by kantoku

Option Explicit

Private Const OTHERCOLOR = "0, 0, 0"

Sub CATMain()

Dim txts As Collection
Set txts = getShowTxts()
If txts Is Nothing Then Exit Sub

Dim colorMap As Variant
colorMap = initColorMap()

Dim sizeDic As Object
Set sizeDic = groupBySize(txts)

Call execChangeColor(sizeDic, colorMap)

MsgBox "Done"
End Sub

Private Sub execChangeColor( _
ByVal group As Object, _
ByVal colorMap As Variant)

Dim sel As selection
Set sel = CATIA.ActiveDocument.selection

Dim vis As VisPropertySet
Set vis = sel.VisProperties

CATIA.HSOSynchronized = False

Dim key As Variant ' Long
Dim rgbAry As Variant
Dim rgbTxt As String
Dim dt As DrawingText
For Each key In group.keys

If UBound(colorMap) > key Then
'In colormap
rgbTxt = colorMap(key)
Else
'other
rgbTxt = OTHERCOLOR
End If

rgbAry = Split(rgbTxt, ",")

sel.Clear
For Each dt In group(key)
sel.Add dt
Next

Call vis.SetRealColor( _
CLng(rgbAry(0)), _
CLng(rgbAry(1)), _
CLng(rgbAry(2)), _
1)

Next

sel.Clear

CATIA.HSOSynchronized = True

End Sub

'return dic(txtsize,lst(drawtxt))
Private Function groupBySize( _
ByVal txts As Collection) _
As Object

Dim dic As Object
Set dic = initDic()

Dim dt As DrawingText
Dim prop As DrawingTextProperties
Dim key As Long
Dim lst As Collection

For Each dt In txts
Set prop = dt.TextProperties
key = CLng(prop.FONTSIZE)

If dic.Exists(key) Then
Call dic(key).Add(dt)
Else
Set lst = New Collection
lst.Add dt
Call dic.Add(key, lst)
End If
Next

Set groupBySize = dic

End Function

Private Function initDic() _
As Object

Set initDic = CreateObject("Scripting.Dictionary")

End Function

Private Function getShowTxts() _
As Collection

Set getShowTxts = Nothing

Dim sel As selection
Set sel = CATIA.ActiveDocument.selection

CATIA.HSOSynchronized = False

sel.Clear
sel.Search "CATDrwSearch.DrwText,all"

CATIA.HSOSynchronized = True

If sel.Count < 1 Then
MsgBox "Text not found"
Exit Function
End If

Dim lst As Collection
Set lst = New Collection

Dim i As Long
For i = 1 To sel.Count
lst.Add sel.Item2(i).value
Next

sel.Clear
Set getShowTxts = lst

End Function

Private Function initColorMap() _
As Variant 'array(str)

initColorMap = Array( _
"255, 255, 0", _
"128, 0, 255", _
"0, 0, 255", _
"0, 128, 255", _
"0, 255, 255", _
"0, 255, 0", _
"0, 128, 0", _
"211, 178, 125", _
"255, 128, 0", _
"255, 0, 0", _
"255, 0, 255", _
"128, 64, 64")

End Function

 

[itsmyjob]

please use DrawingText.GetParameterOnSubString and SetParameterOnSubString

Eric N.
indocti discant et ament meminisse periti ​

 

[Durga Abishek]

ok thanks

 

[kantoku]

It was completed like this.
drawingText_color_change　sample

I want to know three things.
・Why did you delete the first topic?
・Why did you delete another topic answered by Little Cthulhu?
・Do you also delete this topic?

 

[Durga Abishek]

NO I DIDNT DELETE THE TOPIC ENG FORUM DELETED THE TREAD
THATS WHY I POSTED AGAIN

 

[Durga Abishek]

 

[Durga Abishek]

CAN I HAVE YOUR MAIL ID

 

[Little Cthulhu]

Never post your e-mail on a public forum, kids