|
阅读：1901回复：3
通过对话框加载Shapefile完整代码(加载系列一)
<P>Public Sub AddFile()<br> 'AddFile是用来判断加载什么类型的图层并调用相应的函数<br> <br> 'fullFile 为加载图层所在绝对路径,fullFileLEN 绝对路径的长度,afterext文件后缀名不含".",<br> 'Test用于循环fullFile中的所有字符并搜索\出现的最后位置</P>
<P> Dim fullFile As String, tempChar As String, afterext As String<br> Dim TestLoop As Boolean<br> Dim fullFileLEN As Long, CurrentPos As Long<br> Dim partPath As String<br> <br> '通用对话框打开文件的类型<br> <br> Dim strShape As String<br> strShape = "ESRI Shapefiles (*.shp) |*.shp"<br> '设置取消错误后则退出<br> CommonDialog1.CancelError = True<br> On Error GoTo FileOpenCancel<br> <br> CommonDialog1.Filter = strShape<br> CommonDialog1.DialogTitle = "加载新图层"<br> CommonDialog1.ShowOpen<br> <br> 'fullFile 为加载图层所在绝对路径,fullFileLEN 绝对路径的长度<br> If CommonDialog1.FileTitle = "" Then Exit Sub<br> fullFile = Trim$(CommonDialog1.filename)<br> fullFileLEN = Len(fullFile)<br> TestLoop = False</P> <P> '循环fullFile中的所有字符并搜索\出现的最后位置<br> Do While TestLoop = False<br> fullFileLEN = fullFileLEN - 1<br> tempChar = Mid$(fullFile, fullFileLEN, 1)<br> If tempChar = "." Then<br> CurrentPos = fullFileLEN<br> ElseIf tempChar = "\" Or fullFileLEN = 0 Then<br> TestLoop = True<br> End If<br> Loop<br> <br> 'partPath 为去掉．以及．以后的字符，表示．左边的所有字符<br> partPath = Left$(fullFile, fullFileLEN - 1)<br> <br> 'filenamae表示文件名和后缀，prefname文件名，afterext 文件后缀名<br> '将要增加的filenamae和curPath发送到增加图层函数<br> Dim filename As String<br> Dim prefname As String<br> filename = CommonDialog1.FileTitle</P> <P> '通过文件的后缀名来判断调用加载的函数，将文件名和后缀名都转化为小写<br> afterext = LCase(Mid$(fullFile, CurrentPos + 1, 3))<br> prefname = LCase(Mid$(fullFile, fullFileLEN + 1, CurrentPos - (fullFileLEN + 1)))</P> <P> If afterext = "shp" Then Call addShapeFile(partPath, filename)<br> <br> Exit Sub<br> <br>FileOpenCancel:<br> Exit Sub</P> <P>End Sub</P> <P>Private Sub addShapeFile(basepath As String, shpfile As String)<br> 'addShapeFile将ShapeFil文件加入到图层集中<br> Dim dCon As New MapObjects2.DataConnection<br> Dim ds As MapObjects2.GeoDataset<br> Dim strShapefileType As String<br> <br> dCon.Database = basepath '设置数据集的连接路径<br> If dCon.Connect Then<br> shpfile = GetLayerName(shpfile, ".") '从．左边的字符串中提取layerName例如 country<br> Set ds = dCon.FindGeoDataset(shpfile) '在连接的数据集中找到对应的shapefile<br> If ds Is Nothing Then<br> MsgBox "打开shapefile图层错误！ " ; shpfile, vbCritical<br> Exit Sub<br> Else<br> <br> '判断是否包含高程值<br> If ds.HasZ Then<br> strShapefileType = "[SHAPEFILZ]"<br> Else<br> strShapefileType = "[SHAPEFILE]"<br> End If<br> <br> Dim newLayer As New MapLayer<br> newLayer.GeoDataset = ds '设置新加载图层的数据集<br> newLayer.Name = shpfile '设置新加载图层的名称<br> </P> <P> '为图层设置标签，标签包含strShapefileType图层是否包含高层<br> 'dCon.Database图层的读取位置，newLayer.name图层的名称<br> newLayer.Tag = strShapefileType ; dCon.Database ; "|" ; newLayer.Name<br> Map1.Layers.Add newLayer '将新图层加入到图层集中<br> End If<br> Else<br> MsgBox "错误!"<br> End If<br>End Sub</P> <P><br>Function GetLayerName(shpfile As String, Dot As String) As String<br>'GetFirstToken 从．左边的字符串中提取layerName例如 country<br>'Dot 表示"."</P> <P> Dim Split As Long<br> Dim ToName As String<br> shpfile = Trim$(shpfile)</P> <P> Split = InStr(1, shpfile, Dot)</P> <P> If (Split <= 0) Then<br> <br> ' 如果没有字符串则返回整个字符串<br> <br> ToName = shpfile<br> Else<br> <br> '获得layerName例如 country<br> <br> ToName = (Trim$(Left$(shpfile, Split - 1)))<br> End If</P> <P> GetLayerName = ToName</P> <P>End Function<br><a>file://D://AcmeSym.dll</A></P> [此贴子已经被作者于2007-6-18 0:31:47编辑过]
|
|
|
1楼#
发布于：2007-06-14 15:30
<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" />
|
|
|
2楼#
发布于：2007-06-15 20:59
看了后 不会的也会了 多谢阿
|
|
|
|
3楼#
发布于：2007-06-16 19:36
谢谢共享
|
|
