A question of dim text fillcolor

Is there a Property of dim text fill color that can be accessed via VBA?

 

Either pull the dimension apart or modify the dimstyle

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...

 

But I want to modify a single dim.

 

Okay then you need to pull it apart as I said. I guess you're gonna ask how
next, right =) Its rather simple...a dimension is nothing more than a
blockreference with intelligence [ala reactor]. So once you find the name
of the associate *D??? block, you iterate through it looking for just the
text [MText] component and change its color. Here see if you can follow
this --- WATCH OUT FOR WORD WRAPPING:

'##### BEGIN CODE BLOCK ######
Sub ChangeDimTxtColor()
Dim vPickPt As Variant
Dim oDim0 As AcadDimension
Dim oDimDefBlk As AcadBlock
Dim oTestEntity As AcadEntity
Dim oMTxt As AcadMText
Dim iCntr As Integer
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
color.SetRGB 0, 190, 244
ThisDrawing.Utility.GetEntity oDim0, vPickPt, "Pick dimension: "
If oDim0 Is Nothing Then
MsgBox "You failed to pick a dimension object", vbCritical
Exit Sub
ElseIf TypeOf oDim0 Is AcadDimension Then
Set oDimDefBlk = GetDefinition(oDim0.Handle)
For iCntr = 0 To oDimDefBlk.Count - 1
Set oTestEntity = oDimDefBlk(iCntr)
If TypeOf oTestEntity Is AcadMText Then
Set oMTxt = oTestEntity
oMTxt.TrueColor = color
ThisDrawing.Regen acActiveViewport
Exit For
End If
Next
End If
End Sub

Function GetDefinition(sHandle As String) As AcadBlock
' Returns a dimension's controlling block
Dim oBlk As AcadBlock
Dim sLeft As String
Dim sRight As String
Dim bTest As Boolean
On Error GoTo Err_Control
sLeft = Left(sHandle, Len(sHandle) - 2)
sRight = "&H" & Right(sHandle, 2)
sRight = sRight + 1
sHandle = sLeft & Hex(sRight)
bTest = True
Set oBlk = ThisDrawing.HandleToObject(sHandle)
Set GetDefinition = oBlk
Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
Case 13
If bTest Then
sRight = sRight + 1
sHandle = sLeft & Hex(sRight)
Err.Clear
bTest = Not bTest
Resume
Else
Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
End If
Case -2147467259
Err.Clear
MsgBox "Invalid dimension entity...", vbCritical
End
Case Else
Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
End Select
End Function

'##### END CODE BLOCK ######

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...

 

Mike, I tried your code and it always fails to create the handle of the controlling block.

 

Oh yeah, I forgot, the code won't work if you have only one dimension in
the drawing. The first dimension in a drawing always has its block name
equal to its id so tht would need to be added to the error loop. If its the
2nd to nth dimension, the coode will work fine assuming you select a
dimension that isn't exploded.

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...

 

This looks interesting Mike....

I tried to run your code and get a compile error:
USER DEFINED TYPE NOT DEFINED, at the line
Dim color As AcadAcCmColor

If I change it to As Object I get a run time error at:
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
PROBLEM IN LOADING APPLICATION

I am running AutoCAD 2002 and have tried changing the GetInterfaceObject
parameter to "AutoCAD.AcCmColor.15"

Any ideas...

--
Regards
Tom Roberts
__________________________
MechWest Design & Drafting
Perth, Western Australia

 

Yeah Tom, you can't run it in 2002. You need to change TrueColor to simply
Color and pass it either an ac or vb color [acGreen, vbGreen]. True color
didn't come out untill 2004. Also strip the entire loading of the arx file
because you don't have it. Life was simpler in 2002 =)

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...

 

Hi Tom,

I wrote a monumental Case statement to assign layer colours based on the
colour number 1 to 255 and translating it to the colour object.

Then before I even released it, I found the Colorindex property.

Hence my create layer command now reads (schematically)

Create layer
If AcadVersion = 15 then
Layer.color = passedparameter
else
Layer.colorindex = passedparameter
End if

The help sample shows:

Sub Example_ColorIndex()
'This example draws a circle and
'returns the closest color index.

Dim col As New AcadAcCmColor
Call col.SetRGB(125, 175, 235)

Dim cir As AcadCircle
Dim pt(0 To 2) As Double
Set cir = ThisDrawing.ModelSpace.AddCircle(pt, 2)
cir.TrueColor = col
ZoomAll

Dim retCol As AcadAcCmColor
Set retCol = cir.TrueColor

If col.ColorMethod = AutoCAD.acColorMethodByRGB Then
MsgBox "Closest ColorIndex=" & col.ColorIndex
End If

End Sub
--


Laurie Comerford
CADApps
www.cadapps.com.au