Hello,
I made a little utility that can copy and paste a style from object to
selected objects. It might help you.
Cheers
Michel Larue
At 16:16 18/01/2000 -0600, you wrote:
>Mappers:
>
>Is there a way to update an object's style programmatically
>without recreating the object?
>
>A snippet of sample code from the MapBasic Help file says:
>
>'set a new "current symbol style"
>sSymbolAttr = "(35,65280,22)"
>sCmd = "Set Style Symbol MakeSymbol" + sSymbolAttr
>Run Command sCmd
>
>' use an Update statement to create a new Point for
>' every row in the Selection table. Each new Point
>' will use the new "current symbol style"
>Update "Selection"
> Set obj = CreatePoint(CentroidX(obj),CentroidY(obj))
>
>However, I need to do this for polygons!
>
>When working in MapInfo, I can go to "Options | Region Style"
>and modify editable, selected objects in the current window..
>but that doesn't seem to work from within MapBasic (?)
>
>I understand maybe I need to loop through each polygon and
>modify them using Alter Object?
>
>Thanks in advance for any insight!
>
>Eric
>
>
>
>----------------------------------------------------------------------
>To unsubscribe from this list, send e-mail to [EMAIL PROTECTED] and put
>"unsubscribe MAPINFO-L" in the message body, or contact [EMAIL PROTECTED]
ID_STYLE.MBX
'****************************************************************************
'* Name: ID_STYLE1.MB *
'* Author: B.M. Larue *
'* Company: SOPAC *
'* Date: 26/8/95
*
'****************************************************************************
Include "c:\mapinfo\mapbasic\mapbasic.def"
Include "c:\mapinfo\mapbasic\menu.def"
Declare sub Main
Declare Sub Copy_Style
Declare Sub Paste_Style
Declare Sub About
Declare Sub Quit
Declare Sub Null
Global i,k,kmax,j,jmax,imax As Integer ' Whole numbers from
-2,147,483,647 to +2,147,483,647
'Global j As smallInt ' Whole numbers from -32767 to 32767
(inclusive); stored in two bytes
Global x As float ' Floating point value; stored in eight-byte
IEEE format
Global a As string ' Variable-length character string, up to
32767 bytes long
Global b As String * 100 ' Fixed-length character string (where length dictates
the length of the string, in bytes, up to 32767 bytes); fixed-length strings are
padded with trailing blanks
Global Poly As Object ' Graphical object (Point, Region, Line,
Polyline, Arc, Rectangle, Rounded Rectangle, Ellipse, Text, or Frame)
Global Esc As Logical ' TRUE or FALSE, stored in one byte (zero =
FALSE, non-zero = TRUE)
Global D As Date ' (MM/DD/YYYY), stored in four
bytes: two bytes for the year, one byte for the month, one byte for the day
Global C As Alias ' Column name
Global P As Pen ' Pen (line) style setting
Global Br As Brush ' Brush (fill) style setting
Global F As Font ' Font (text) style setting
Global S As Symbol ' Symbol (point-marker) style setting
Global win_id As Integer
Global zoom_win As float
Global scale As float
Global xcenter As float
Global ycenter As float
Global xmin As float
Global ymin As float
Global xmax As float
Global ymax As float
Global units As string
Global dist_unit As string
Global scroll As logical
Global Win_x As float
Global Win_y As float
Global object As object
Global ObjColumn as alias
Global obj_type As Integer
Sub Main
Create Menu "&ID_STYLE"
As "Copy_Style" Calling Copy_Style,
"Past_Style" Calling Paste_Style,
"(-",
"About" Calling About,
"(-",
"Exit" Calling Quit
Alter Menu Bar Add "&ID_STYLE"
End Sub ' Main
sub Copy_Style
if selectioninfo(SEL_INFO_NROWS) <> 1 then
note "Select ONE object first"
exit sub
end if
P = CurrentPen()
Br = CurrentBrush()
F = CurrentFont()
S = CurrentSymbol()
ObjColumn = Selection + ".obj"
obj_type = ObjectInfo(ObjColumn , OBJ_INFO_TYPE)
object = ObjColumn
Do case obj_type
Case OBJ_PLINE
P = ObjectInfo(object,OBJ_INFO_PEN )
Case OBJ_REGION
Br = ObjectInfo(object,OBJ_INFO_BRUSH )
P = ObjectInfo(object,OBJ_INFO_PEN )
Case OBJ_LINE
P = ObjectInfo(object,OBJ_INFO_PEN )
Case OBJ_POINT
S = ObjectInfo(object,OBJ_INFO_SYMBOL )
Case OBJ_TEXT
F = ObjectInfo(object,OBJ_INFO_TEXTFONT )
Case OBJ_ARC
P = ObjectInfo(object,OBJ_INFO_PEN )
Case OBJ_ELLIPSE
Br = ObjectInfo(object,OBJ_INFO_BRUSH )
P = ObjectInfo(object,OBJ_INFO_PEN )
Case OBJ_RECT
Br = ObjectInfo(object,OBJ_INFO_BRUSH )
P = ObjectInfo(object,OBJ_INFO_PEN )
Case OBJ_ROUNDRECT
Br = ObjectInfo(object,OBJ_INFO_BRUSH )
P = ObjectInfo(object,OBJ_INFO_PEN )
Case else
Call NULL
End Case
end sub ' Copy_Style
sub Paste_Style
if selectioninfo(SEL_INFO_NROWS) = 0 then
note "Select object(s) first"
exit sub
end if
kmax = selectioninfo(SEL_INFO_NROWS)
cls
for k = 1 to kmax
Fetch rec k from Selection
ObjColumn = Selection + ".obj"
obj_type = ObjectInfo(ObjColumn , OBJ_INFO_TYPE)
object = ObjColumn
Do case obj_type
Case OBJ_PLINE
jmax = ObjectInfo(ObjColumn , OBJ_INFO_NPOLYGONS)
For j = 1 To jmax
Alter Object object
Info OBJ_INFO_Pen, P
Next
Case OBJ_REGION
jmax = ObjectInfo(ObjColumn , OBJ_INFO_NPOLYGONS)
For j = 1 To jmax
Alter Object object
Info OBJ_INFO_Brush, Br
Info OBJ_INFO_Pen, P
Next
Case OBJ_LINE
Alter Object object
Info OBJ_INFO_Pen, P
Case OBJ_POINT
Alter Object object
Info OBJ_INFO_Symbol, S
Case OBJ_TEXT
Alter Object object
Info OBJ_INFO_TEXTFONT , F
Case OBJ_ARC
Alter Object object
Info OBJ_INFO_Pen, P
Case OBJ_ELLIPSE
Alter Object object
Info OBJ_INFO_Brush, Br
Info OBJ_INFO_Pen, P
Case OBJ_RECT
Alter Object object
Info OBJ_INFO_Brush, Br
Info OBJ_INFO_Pen, P
Case OBJ_ROUNDRECT
Alter Object object
Info OBJ_INFO_Brush, Br
Info OBJ_INFO_Pen, P
Case else
Call NULL
End Case
Update Selection Set obj = object Where Rowid = k
next
end sub ' Paste_Style
Sub About
Note "This Map Basic " + chr$(13) +
"1. Take the characteristics of an object" + chr$(13) +
"2. Aand Paste it to another one" + CHR$(13) + CHR$(13) +
"® Michel Larue SOPAC 1995"
End Sub ' About
Sub NULL
End Sub 'NULL
Sub Quit
Alter Menu Bar Remove "&ID_STYLE"
end program
End Sub ' Quit
+------------------------------------------------------------------
| Michel Larue
| Représentant IRD
| B.P. 172
| 97492 Sainte Clotilde
| La Réunion
| mailto:[EMAIL PROTECTED]
| <http://www.univ-reunion.fr/~ird/>
| Tel (Office) +262 29 56 29
| Fax +262 28 48 79
| Tel (Home) +262 29 22 05
| Tel (GSM) +262 82 83 08
| De France ajouter un zéro devant
+-----------------------------------------------------------------
