|
阅读：1523回复：2
想用VBA打开一个coverage
<P>Dim pWorkspaceFactory As IWorkspaceFactory
Set pWorkspaceFactory = New ShapefileWorkspaceFactory Dim pWorkSpace As IFeatureWorkspace Set pWorkSpace = pWorkspaceFactory.OpenFromFile("C:\Source\", 0) Dim pClass As IFeatureClass Set pClass = pWorkSpace.OpenFeatureClass("USStates") Dim pLayer As IFeatureLayer Set pLayer = New FeatureLayer Set pLayer.FeatureClass = pClass pLayer.Name = pClass.AliasName Dim pMxDoc As IMxDocument Set pMxDoc = ThisDocument pMxDoc.AddLayer pLayer pMxDoc.ActiveView.PartialRefresh esriViewGeography, pLayer, Nothing</P> <P>上面是例子中的打开shapefile,我现在想用此来打开coverage中的featureclass，怎么改，还请高手帮忙！先谢谢</P> |
|
|
1楼#
发布于：2005-07-13 18:18
<P>Dim pWorkspaceFactory As IWorkspaceFactory<BR>Set pWorkspaceFactory = New <a href="ms-its:esriDataSourcesFile.chm::/ArcInfoWorkspaceFactory.htm" target="_blank" ><STRONG>ArcInfoWorkspaceFactory </STRONG></A><BR>Dim pWorkSpace As IFeatureWorkspace<BR>Set pWorkSpace = pWorkspaceFactory.OpenFromFile("C:\Source\", 0)<BR>Dim pClass As IFeatureClass<BR>Set pClass = pWorkSpace.OpenFeatureClass("USStates:polygon") '如果USStates是polygon文件类型<BR>Dim pLayer As IFeatureLayer<BR>Set pLayer = New FeatureLayer<BR>Set pLayer.FeatureClass = pClass<BR>pLayer.Name = pClass.AliasName<BR>Dim pMxDoc As IMxDocument<BR>Set pMxDoc = ThisDocument<BR>pMxDoc.AddLayer pLayer<BR>pMxDoc.ActiveView.PartialRefresh esriViewGeography, pLayer, Nothing</P>
|
|
|
2楼#
发布于：2005-08-08 16:35
<P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly">Private Sub ConnectCoverageFile(ByVal sFilePath As String, ByVal sFileName As String)<p></p></P>
<P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pWorkspace As IWorkspace<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pWorkspaceFactory As IWorkspaceFactory<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pPropertySet As IPropertySet<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pDataset As IDataset<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pEnumDataset As IEnumDataset<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pFeatureClassC As IFeatureClassContainer<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pFeatureLayer As IFeatureLayer<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pMxDocument As IMxDocument<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim pMap As IMap<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim nNumber As Integer<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Dim sWorkspace As String<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> <p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly">On Error GoTo ErrorHandler:<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> <p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> sWorkspace = Dir(sFilePath, vbDirectory)<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> If (sWorkspace = "") Then<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> MsgBox ("文件不存在")<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Exit Sub<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> End If<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Set pWorkspaceFactory = New ArcInfoWorkspaceFactory<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Set pPropertySet = New PropertySet<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> 'canada is an arcinfoworkspace<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> pPropertySet.SetProperty "DATABASE", sFilePath<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> 'pWorkSp is a pointer to the IArcInfoWorkspace<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Set pWorkspace = pWorkspaceFactory.Open(pPropertySet, 0)<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> 'now get to dataset objects using Idataset<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Set pDataset = pWorkspace<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> <p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> 'use enum to get datasets<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> Set pEnumDataset = pDataset.Subsets<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"> pEnumDataset.Reset<p></p></P> <P> 'use FeatureClassContainer to get datasets</P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000>Set pFeatureClassC = pEnumDataset.Next<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Do While Not pFeatureClassC Is Nothing<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Set pDataset = pFeatureClassC<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> If (pDataset.Name <> sFileName) Then<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Set pFeatureClassC = pEnumDataset.Next<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Else<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Exit Do<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> End If<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Loop<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> </FONT>'add FeatureClassContainer to map<p></p></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> If (pFeatureClassC Is Nothing) Then<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> MsgBox ("文件不存在")<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Else<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> nNumber = 0<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Set pMxDocument = ThisDocument<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Set pMap = pMxDocument.FocusMap<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> <p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Do While nNumber < pFeatureClassC.ClassCount<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Set pFeatureLayer = New FeatureLayer<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Set pFeatureLayer.FeatureClass = pFeatureClassC.Class(nNumber)<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> nNumber = nNumber + 1<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> pMap.AddLayer pFeatureLayer<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Loop<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> End If<p></p></FONT></P> <P 0cm 0cm 0pt; LINE-HEIGHT: 10pt; mso-line-height-rule: exactly"><FONT color=#000000> Exit Sub<p></p></FONT></P> <P> </P> |
|
