[V8i SS2] Pen Table hook Script Macro - Read RGB color and substitute for another

Offline cweber over 11 years ago

Concluding the following post I determined to try element color substituation in a Pen Table Hook script.

http://communities.bentley.com/products/microstation/microstation_v8i/f/19568/p/84282/236986.aspx#236986

However, I am not familiar with the old BASIC macro syntax and was hoping that somebody here could help me please?

I would like to scan element colors for specific RGB values and if found specify substitute RGB values. If not found then set the color to print Black RGB(0,0,0).

I tried various commands like follows but have not been able to get even a simple script to work.

elem.Color = ActiveModelReference.InternalColorFromRGBColor(RGB(225,225,225)

As I understand the process I "wish the element to be passed to a function in a MicroStation BASIC macro as an MbeElement... to Specify Pen Table Output Actions", where "color resymbolization is specified" as an Output Actions via this hook script such that "color resymbolizations is applied to the MbeElement object as it is passed to the BASIC function, overriding the print color.

I am also contemplating if this is simpler and would perform faster in V8i SS3 with the updated Pen Table script functionality?

0 Offline Oto Mon, Dec 16 2013 10:52 AM
This is not possible directly in MS-BASIC because it can't read RGB colors and in each file color indexes for RGB colros are different. In SS3 you can use "Design scripts" instead of pentable. But it is not compatible with older versions nor it allows to map source RGB colors. Other way would be to call VBA functions from MSBASIC plot hook macro.

I have created such function to invert RGB white to black until issue with printing RGB white is not resolved(TR 343558). It works but it is not guaranteed 100% as it works only if RGB white in DGN has either 256 OR 512 OR 1280 color index.

Function RGB_W2B (elm as MbeElement) As Long
Dim linkArray(1 To 3) As Integer
Dim patternlinkArray(3 to 51) 'As Integer

'   print elm.color


status = elm.extractLinkage (linkArray, 65) 'try to extract fill attribute
    If status = 0 AND elm.isGraphics AND (elm.color=512 OR elm.color=1280) Then
       linkArray(1) = 8
       linkArray(2) = 0
        linkArray(3) = 0 ' color is an Integer
       stat=elm.deleteLinkage(65,-1) 'delete old linkage
        stat=elm.appendLinkage(linkArray,65) 'recreate new linkage

              ' stat=elm.rewrite()
    End If

status = elm.extractLinkage (patternlinkArray, 32040) 'try to extract patter attribute
    If status = 0 AND elm.isGraphics AND (elm.color=512 OR elm.color=1280) Then

        patternlinkArray(17) = 0 ' color is an Integer
        patternlinkArray(18) = 0 ' color is an Integer

       stat=elm.deleteLinkage(32040,-1) 'delete old linkage
        stat=elm.appendLinkage(patternlinkArray,32040) 'recreate new linkage

              ' stat=elm.rewrite()
   End If

'MbeSendCommand "co=RGB:255:255:255"

'elm.color = MbeSettings.color
If elm.color=256 then elm.color=0
If elm.color=512 then elm.color=0
If elm.color=1280 then elm.color=0


    RGB_W2B = MBE_ElemNormal

End Function
Cancel
Vote Up 0 Vote Down

Sign in to reply

Verify Answer

Cancel
0 Offline Oto Fri, Jan 31 2014 5:07 AM in reply to Oto
Attaching also a Design script which is easier to use. Tried to use it for HTML Author tool but didn't work.

Regarding design scripts same issue as before, it doesn't allow to map RGB to RGB, only index colors to RGB.
RGB_W2B.zip
Cancel
Vote Up 0 Vote Down

Sign in to reply

Verify Answer

Cancel
0 Offline cweber Sun, Feb 2 2014 3:47 PM in reply to Oto

Thanks Oto :)

Due to the problematic nature of using 'full' True colour for all layer/printing requirements, I dropped the approach and am predominantely using colour tables again. There are just too many issues and bugs with the use of True Colour for everything.
Cancel
Vote Up 0 Vote Down

Sign in to reply

Verify Answer

Cancel

0 Offline Oto Thu, May 14 2015 9:54 AM in reply to cweber

Time goes on but still this issue is not resolved and even if it will be it won't be backwards compatible.

So attaching latest pentable hook macro which I now hacked to work with RGB colors. At least RGB white to black prints ok.

Type MbeRGB
     R As integer
     G As integer
     B As integer
 End Type


sub main

End Sub

Function RGB_W2B (elm as MbeElement) As Long
      Dim linkArray(1 To 3) As Integer
      Dim patternlinkArray(3 to 51) 'As Integer
      dim ElemRGBcolor as MbeRGB
'   print elm.color
    

'MbeSendCommand "co=RGB:255:255:255"

''elm.color = MbeSettings.color 
'  If  elm.color=256 then elm.color=0
'  If  elm.color=512 then elm.color=0
'If  elm.color=1280 then elm.color=0

status = MbeCExpressionLong ("tcb->uc_i[1]="&cstr(elm.color)) 'set uc_i[1] register to element color


'status = MbeCExpressionString ("mdlModelRef_getActive()") 'MASTERFILE modelref
'status = MbeCExpressionString ("mdlModelRef_getDgnFile(mdlModelRef_getActive())") 'DgnFileP


   status2$ = MbeCExpressionString ("mdlColor_elementColorToRGB (" + _
                                "&tcb->uc_i[0]," + _
                                "((void *)0)," + _
                                "mdlModelRef_getActive()," + _
                                "tcb->uc_i[1]," + _
                                "((void *)0)" + _
                                ")")
   
  ' status$ = MbeCExpressionString ("mdlColor_elementColorToRGBInFile (" + _
  '                              "&tcb->uc_i[0]," + _
  ''                              "mdlModelRef_getDgnFile(mdlModelRef_getActive())," + _
  ''                              "1," + _
  ''                              "((void *)0)" + _
  ''                              ")")
 ''  status$ = MbeCExpressionString ("mdlColor_rawColorFromRGBColor (" + _
  ''                              "&tcb->uc_i[1]," + _
  ''                              "&tcb->uc_i[0]," + _
  ''                              "mdlModelRef_getActive()" + _
  ''                                 ")")
 ''  rawcolor$ = MbeCExpressionString ("tcb->uc_i[1]")
                                
   
   elemRGBcolor.R = MbeCExpressionLong("(unsigned char)(tcb->uc_i[0])&(0xffL)")
   elemRGBcolor.G = MbeCExpressionLong("((unsigned char)(tcb->uc_i[0])>>8) & (0xffL)")
   elemRGBcolor.B = MbeCExpressionLong("((unsigned char)(tcb->uc_i[0])>>16) &(0xffL)")
   status = elm.extractLinkage (linkArray, 65) 'try to extract fill attribute
    If status = 0 AND elm.isGraphics AND (elm.color>255 AND elemRGBcolor.R=255 AND elemRGBcolor.G=255 AND elemRGBcolor.B=255) Then   
       linkArray(1) = 8
       linkArray(2) = 0
        linkArray(3) = 0  ' color is an Integer  
       stat=elm.deleteLinkage(65,-1) 'delete old linkage
        stat=elm.appendLinkage(linkArray,65) 'recreate new linkage
        
              '  stat=elm.rewrite()
    End If



status = elm.extractLinkage (patternlinkArray, 32040) 'try to extract patter attribute
    If status = 0 AND elm.isGraphics AND (elm.color>255 AND elemRGBcolor.R=255 AND elemRGBcolor.G=255 AND elemRGBcolor.B=255) Then   
     
        patternlinkArray(17) = 0  ' color is an Integer
        patternlinkArray(18) = 0  ' color is an Integer
        
       stat=elm.deleteLinkage(32040,-1) 'delete old linkage
        stat=elm.appendLinkage(patternlinkArray,32040) 'recreate new linkage
        
              '  stat=elm.rewrite()
   End If

If  elm.color>255 AND elemRGBcolor.R=255 AND elemRGBcolor.G=255 AND elemRGBcolor.B=255 then elm.color=0

'print elm.color

    RGB_W2B = MBE_ElemNormal
     
 End Function

0 Offline cweber Thu, May 14 2015 6:37 PM in reply to Oto

Thanks for sharing this with us :)
Cancel
Vote Up 0 Vote Down

Sign in to reply

Verify Answer

Cancel

0 Offline Oto Tue, Dec 27 2016 5:46 AM in reply to cweber

Updated version as previous version didn't correctly remap elements in reference files

Type MbeRGB
     R As integer
     G As integer
     B As integer
 End Type


sub main

End Sub

Function RGB_W2B (elm as MbeElement) As Long
      Dim linkArray(1 To 3) As Integer
      Dim patternlinkArray(3 to 51) 'As Integer
      dim ElemRGBcolor as MbeRGB


status = MbeCExpressionLong ("tcb->uc_i[1]="&cstr(elm.color)) 'set uc_i[1] register to element color
status3$ = MbeCExpressionString ("tcb->uc_a[0]="&cstr(elm.fileNum)) 'set uc_a[0] register to element ref number



   status2$ = MbeCExpressionString ("mdlColor_elementColorToRGB (" + _
                                "&tcb->uc_i[0]," + _
                                "((void *)0)," + _
                                "tcb->uc_a[0]," + _
                                "tcb->uc_i[1]," + _
                                "((void *)0)" + _
                                ")")
                                  
   
   elemRGBcolor.R = MbeCExpressionLong("(unsigned char)(tcb->uc_i[0])&(0xffL)")
   elemRGBcolor.G = MbeCExpressionLong("((unsigned char)(tcb->uc_i[0])>>8) & (0xffL)")
   elemRGBcolor.B = MbeCExpressionLong("((unsigned char)(tcb->uc_i[0])>>16) &(0xffL)")

'Check element fill
   status = elm.extractLinkage (linkArray, 65) 'try to extract fill attribute
    If status = 0 AND elm.isGraphics AND (elm.color>255 AND elemRGBcolor.R=255 AND elemRGBcolor.G=255 AND elemRGBcolor.B=255) Then   
       linkArray(1) = 8
       linkArray(2) = 0
        linkArray(3) = 0  ' color is an Integer  
       stat=elm.deleteLinkage(65,-1) 'delete old linkage
        stat=elm.appendLinkage(linkArray,65) 'recreate new linkage
        
          
    End If


'Check pattern color
status = elm.extractLinkage (patternlinkArray, 32040) 'try to extract patter attribute
    If status = 0 AND elm.isGraphics AND (elm.color>255 AND elemRGBcolor.R=255 AND elemRGBcolor.G=255 AND elemRGBcolor.B=255) Then   
     
        patternlinkArray(17) = 0  ' color is an Integer
        patternlinkArray(18) = 0  ' color is an Integer
        
       stat=elm.deleteLinkage(32040,-1) 'delete old linkage
        stat=elm.appendLinkage(patternlinkArray,32040) 'recreate new linkage
        
          
   End If

If  elm.color>255 AND elemRGBcolor.R=255 AND elemRGBcolor.G=255 AND elemRGBcolor.B=255 then elm.color=0


    RGB_W2B = MBE_ElemNormal
     
 End Function

0 Offline Lorys Fri, Jan 27 2017 4:16 AM in reply to Oto
the only vba version I could find is here

http://communities.bentley.com/products/microstation/w/microstation__wiki/22616.how-to-read-the-rgb-values-of-the-attached-color-table

but its not as good as the old bas Draw colour updated ( attached) as that does export to txt as well as create graphical swatches are very helpfull printed out to see final result on paper or pdf good for calibration of printers and comparison of all sorts of issues...

if your using v8i you can still use the attached old bas and work out what needs changing to make a new colour table...from the prints or txtColortbl2txt.zip

Lorys

Started msnt work 1990 - Retired Nov 2022 ( oh boy am I old )

But was long time user V8iss10 (8.11.09.919) dabbler CE update 16 (10.16.00.80)

MicroStation user since 1990 Melbourne Australia.
click link to PM me
Cancel
Vote Up 0 Vote Down

Sign in to reply

Verify Answer

Cancel
0 Offline Oto Fri, Jan 27 2017 5:21 AM in reply to Lorys
What we do is use RGB values instead of indexed colors and that is where lot of problems arise. Microstation uses RGB colors and element templates but the implementation is far from perfect.

In CONNECT edition it is now possible to use VBA for remapping - communities.bentley.com/.../381478

But I still miss simple functionality as VBA is not reliable and overkill for just simple purpose. MSBASIC and Pentables/Design script just work but VBA depends on external libraries which can fail after any Windows Update or MS Office installations also depends on regional settings, Windows language, Windows version. Users do not expect that printout preparation rely heavily on macros so it should be transparent and trouble free.
Cancel
Vote Up 0 Vote Down

Sign in to reply

Verify Answer

Cancel