I have a real quick .mb that I wrote to copy paste fill paterns from one polygon to another or one polygon to multiple. Basically it works like this. It has a toolbar with the letters C one one button and the letter P on another button. Select the polygon with the fill pattern you want then click the C button. Then select the polygon or polygons that you want to have the same fill color and click the P button. It fills the selected polygons with the original polygons pen and brush styles. Basically works like the little dropper tool in MS Paint. Here is the source code. If you like the idea and it's kind of what you are looking for but you can't compile it e-mail me and I'll zip it up and send it to you. It really doesn't do much but it works for what I use it for which is I send a polygons template to whomever I am creating a map for and I have them fiddle with what color they want then fill in the labels and e-mail it back to me. Then I use this to put their colors into the appropriate features. '----------code--------------------------------- Include "MapBasic.Def" Include "icons.def" Declare Sub Brusher Declare Sub Filler Declare Sub Main Global New_pattern As Integer Global New_forecolor As Integer Global New_backcolor As Integer
Sub Main Create Buttonpad "Brushes_1" As Pushbutton calling Brusher HelpMsg "\nCopy brush styles" icon 100 Pushbutton calling Filler HelpMsg "\nPaste brush styles" icon 113 End Sub Sub Brusher Dim Norm_fillstyle As Brush Dim Br_String As String Dim Br_Whole_String As String Dim Br_First_String As String Dim Br_Second_String As String Dim Br_Third_String As String Dim Br_Fourth_String As String Dim First_comma As Integer Dim Second_comma As Integer Dim Br_Len As Integer Dim Br_New_Len As Integer Dim Br_New_Len1 As Integer OnError Goto Make_Sel Norm_fillstyle = ObjectInfo(Selection.obj, OBJ_INFO_BRUSH) Br_String = Str$(Norm_fillstyle) Br_Len = Len(Br_String) Br_Whole_String = Mid$(Br_String, 8, Br_Len - 8) Br_New_Len = Len(Br_Whole_String) First_comma = InStr(1, Br_Whole_String, ",") Br_First_String = Mid$(Br_Whole_String, 1, First_comma - 1) 'Note "First String Is: " & Br_First_String Br_Second_String = Mid$(Br_Whole_String, First_comma + 1, Br_New_Len - First_comma) 'Note "Second String Is: " & Br_Second_String If InStr(1, Br_Second_String, ",") = 0 Then New_pattern = Val(Br_First_String) New_forecolor = Val(Br_Second_String) New_backcolor = -1 Else Second_comma = InStr( 1, Br_Second_String, ",") Br_New_Len1 = Len(Br_Second_String) Br_Third_String = Mid$(Br_Second_String, 1, Second_comma - 1) Br_Fourth_String = Mid$(Br_Second_String, Second_comma + 1, Br_New_Len1 - Second_comma) New_pattern = Val(Br_First_String) New_forecolor = Val(Br_Third_String) New_backcolor = Val(Br_Fourth_String) End If 'Note Br_New_String Exit Sub Make_Sel: Note "You must select a polygon first." End Sub Sub Filler Dim New1_fillstyle As Brush Dim temp1 As Object New1_fillstyle = MakeBrush(New_pattern, New_forecolor, New_backcolor) Select * From Selection Into tab1 Fetch First From tab1 Do While NOT EOT(tab1) temp1 = tab1.obj Alter Object temp1 Info OBJ_INFO_BRUSH, New1_fillstyle Update Selection Set obj = temp1 Fetch Next From tab1 Loop End Sub '------------------end code------------------------------------- The e-mail might wind some of that so make sure you have no broken lines of code when you compile. Also this creates a whole bunch of Query tables and this particular code doesn't delete them so you will have to do it manually. I have only tested this on NT and 2K. Hope it helps. --------------------------------------------------------------------- List hosting provided by Directions Magazine | www.directionsmag.com | To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] Message number: 3244 --------------------------------------------------------------------- List hosting provided by Directions Magazine | www.directionsmag.com | To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] Message number: 3250