-
Notifications
You must be signed in to change notification settings - Fork 0
/
MI2RGB_Folder.mb
155 lines (99 loc) · 5.26 KB
/
MI2RGB_Folder.mb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
' Fügt Spalten fill, R,G,B hinzu
Include "MapBasic.def"
Dim vPath, pToConvert, vPathExp as String
Dim myArray() as String '// create an array to store the table paths
Dim tabName, tabPath, txtFile as String
Dim i as Integer
Declare Sub Main
Declare Sub ReadTextFileToArray(ByVal txtFilePath as String, myArray() as String)
Sub ReadTextFileToArray(ByVal txtFilePath as String, myArray() as String)
Dim i as Integer
i = 1
Note "Text Dokumente mit allen .TAB files im Ordner erfolgreich erstellt unter " + txtFilePath +" ."
Open file txtFilePath for INPUT as #1
Do Until EOF(1) '// do until the end of file #1 is reached
Redim myArray(i) '// resize array to i
Input #1, myArray(i) '// read value from text file
i = i + 1 '// increment i
Loop '// return to Do Until...
End Sub
Sub Main()
vPath = "G:\USER\Mey\Daten\"
pToConvert = FileOpenDlg(vPath+ "","TAB",".TAB", "Open Layer where RGB should be added")
vPath = PathToDirectory$(pToConvert)
Run program "Cmd.exe dir" + vPath+ " echo.>Liste.txt"
Run program "Cmd.exe /c dir """+vPath+"*.TAB"" /b /w > """+vPath+"Liste.txt"""
Run program "Cmd.exe /c taskkill /IM cmd.exe"
txtFile = vPath + "Liste.txt"
Call ReadTextFileToArray(txtFile, myArray) '// populate your array with the table paths from the text file
For i = 1 to UBound(myArray)
If right$(myArray(i), 3) = "TAB" then '// check that this is a tab file path
tabPath = myArray(i) '// get path from array
Open table tabPath '// open table
tabName = TableInfo(0, TAB_INFO_NAME)
If TableInfo(tabName,5) Then
Alter Table tabName ( add fill Integer, R Integer, G Integer,B Integer, line_type Integer, line_width_orig Integer, line_width_qgis Integer) Interactive
OnError Goto Weitermachen2
Alter Table tabName (add Angle float)
Weitermachen2:
Select * From tabName where Str$(obj) = "Point" into Points
Update Points Set fill = styleattr(objectinfo(obj,2),2)
Select * From tabName where Str$(obj) = "Collection" into Collections
Update Collections Set fill = 0
Select * From tabName where Str$(obj) = "Line" into Lines
Update Lines Set fill = styleattr(objectinfo(obj,2),4)
Update Lines Set line_type = styleattr(objectinfo(obj,2),2)
Update Lines Set line_width_orig = styleattr(objectinfo(obj,2),1)
Update Lines Set line_width_qgis = styleattr(objectinfo(obj,2),1)
Select * From Lines where line_width_qgis > 8 AND line_width_qgis < 21 into Lines_width
Update Lines_width set line_width_qgis = 1
Select * From Lines where line_width_qgis = 25 OR line_width_qgis = 30 into Lines_width
Update Lines_width set line_width_qgis = 2
Select * From Lines where line_width_qgis = 35 into Lines_width
Update Lines_width set line_width_qgis = 3
Select * From Lines where line_width_qgis = 40 into Lines_width
Update Lines_width set line_width_qgis = 4
Select * From Lines where line_width_qgis = 50 into Lines_width
Update Lines_width set line_width_qgis = 5
Select * From Lines where line_width_qgis = 60 into Lines_width
Update Lines_width set line_width_qgis = 6
Select * From Lines where line_width_qgis = 70 into Lines_width
Update Lines_width set line_width_qgis = 7
Select * From tabName where Str$(obj) = "Polyline" into Lines
Update Lines Set fill = styleattr(objectinfo(obj,2),4)
Update Lines Set line_type = styleattr(objectinfo(obj,2),2)
Update Lines Set line_width_orig = styleattr(objectinfo(obj,2),1)
Update Lines Set line_width_qgis = styleattr(objectinfo(obj,2),1)
Select * From Lines where line_width_qgis > 8 AND line_width_qgis < 21 into Lines_width
Update Lines_width set line_width_qgis = 1
Select * From Lines where line_width_qgis = 25 OR line_width_qgis = 30 into Lines_width
Update Lines_width set line_width_qgis = 2
Select * From Lines where line_width_qgis = 35 into Lines_width
Update Lines_width set line_width_qgis = 3
Select * From Lines where line_width_qgis = 40 into Lines_width
Update Lines_width set line_width_qgis = 4
Select * From Lines where line_width_qgis = 50 into Lines_width
Update Lines_width set line_width_qgis = 5
Select * From Lines where line_width_qgis = 60 into Lines_width
Update Lines_width set line_width_qgis = 6
Select * From Lines where line_width_qgis = 70 into Lines_width
Update Lines_width set line_width_qgis = 7
Select * From tabName where Str$(obj) = "Region" into Regions
Update Regions Set fill = styleattr(objectinfo(obj,3),2)
Select * From tabName where Str$(obj) = "Text" into Texts
Update Texts Set fill = styleattr(objectinfo(obj,2),4), Angle = ObjectGeography(obj, 7) 'FontSize = styleattr(objectinfo(obj,2),3)
Drop Table Points
Drop Table Lines
Drop Table Collections
Drop Table Regions
Drop Table Texts
Update tabName Set R = fill\65536
Update tabName Set G = (fill - (fill \ 65536)*65536)\256
Update tabName Set B = (fill - ((fill \ 65536)*65536) - (((fill - (fill \ 65536)*65536)\256))*256)
Commit table tabName
Pack table tabName Graphic Data
End if
End If
Next
Browse * From tabName
End Sub