本帖最后由 xyz_2019 于 2022-6-13 17:48 编辑
为摆脱在线转svg到GeoJson工具的每月3次转换限制，并且提高生成自定义地图的效率和区块之间位置、比例的准确性，尝试在Auto CAD内制作VBA工程，并通过CAD VBA工程从CAD工程文件导出自定义地图（area）和点（point）对象为txt文件，然后通过记事本或者Visual Studio简单编辑txt文件，最后修改文件后缀名为json即可：
1. 在CAD的”模型“编辑框内，使用多段线绘制出各个封闭区块；
2. 在CAD的Visual Basic编辑器内贴入以下代码，并运行，导出txt文件：
有两个函数，分别用于导出区块和点两种对象，注意红色加粗内容是导出文件保存位置，需要自行修改
Sub 导出多段线对象坐标到txt文件再转GeoJson文件作为area文件()
Dim Ent As Object
Dim getDpts As Variant
Dim 每个点坐标前字符串 As String
Dim 每个点坐标后字符串 As String
Dim 坐标x As String
Dim 坐标y As String
Open "i:\alltext.txt" For Append As #1
Print #1, "{""type"": ""FeatureCollection"",""creator"": ""xyz_2019"",""name"": ""DSXGZD"",""features"": ["
每个点坐标前字符串名字前 = "{ ""type"": ""Feature"", ""properties"": { ""name"": """
每个点坐标前字符串名字后 = """}, ""geometry"": { ""type"": ""Polygon"", ""coordinates"": [ [ "
每个点坐标后字符串 = "] ] } },"
j = 1
For Each Ent In ThisDrawing.ModelSpace
If Ent.ObjectName = "AcDbPolyline" Then
If j = 1 Then
Print #1, 每个点坐标前字符串名字前 & "坝体轮廓" & 每个点坐标前字符串名字后
ElseIf j = 2 Then
Print #1, 每个点坐标前字符串名字前 & "坝轴线" & 每个点坐标前字符串名字后
Else
Print #1, 每个点坐标前字符串名字前 & CStr(j - 2) & 每个点坐标前字符串名字后
End If
getDpts = Ent.Coordinates
For i = 0 To UBound(Ent.Coordinates) \ 2
If Left(getDpts(i * 2), 1) = "." Then
坐标x = "0" & getDpts(i * 2)
Else
坐标x = getDpts(i * 2)
End If
If Left(getDpts(i * 2 + 1), 1) = "." Then
坐标y = "0" & getDpts(i * 2 + 1)
Else
坐标y = getDpts(i * 2 + 1)
End If
If i < UBound(Ent.Coordinates) \ 2 Then
Print #1, "[" & 坐标x & ", " & 坐标y & " ],"
Else
Print #1, "[" & 坐标x & ", " & 坐标y & " ]"
End If
Next i
Print #1, 每个点坐标后字符串
End If
j = j + 1
Next Ent
Print #1, "] }"
Close #1
MsgBox "已完成"
End Sub
Sub 导出点对象坐标到txt文件再转GeoJson文件作为point文件()
Dim Ent As Object
Dim getDpts As Variant
Dim 每个点坐标前字符串 As String
Dim 每个点坐标后字符串 As String
Open "i:\alltext.txt" For Append As #1
Print #1, "{""type"": ""FeatureCollection"", ""features"": ["
每个点坐标前字符串 = "{ ""type"": ""Feature"", ""properties"": { ""name"": ""N""}, ""geometry"": { ""type"": ""Point"", ""coordinates"": [ "
每个点坐标后字符串 = "] } },"
For Each Ent In ThisDrawing.ModelSpace
If Ent.ObjectName = "AcDbPoint" Then
Print #1, 每个点坐标前字符串
getDpts = Ent.Coordinates
Print #1, "[" & getDpts(0) & ", " & getDpts(1) & " ]"
Print #1, 每个点坐标后字符串
End If
Next Ent
Print #1, "] }"
Close #1
MsgBox "已完成"
End Sub
3. 用记事本或者Visual Studio打开导出的txt文件，进行编辑和修改：
主要是修改区块的名称，并排除结尾的一个语法瑕疵。
4. 最后修改文件名格式
区块对象格式为”******_area.json“，点对象格式为”******_point.json“，复制到这个文件夹就可以用了
5. 可能需要多次尝试，才能呈现最理想的自定义地图：
以上为个人经验，或有不足之处，请多指导交流。
|
陕公网安备：61019002000258 |
隐私政策 |
网站地图
虽然看不懂