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
