|
阅读：1854回复：2
读CAD层的两种方法,初学者必看
<P> 本人一直在读取CAD文件进行操作下了很多苦功夫,可是最终还是发现还是在载入CAD文件时出了问题,就是<FONT color=#ff0000>读CAD的方法根本就是错了</FONT>,因此不能获取CAD层的点线面的属性,没有办法像操作SHAPE那样,希望操作CAD层数据的朋友仔细看一下,代码如下:</P>
<P><FONT color=#ff0000>1:将CAD文件当做栅格图调</FONT></P> <P><FONT color=#0033ff>这是本人一直用的方法,所以导致不能操作CAD层的数据,不能编辑不能读取,像获取"点"之类的方法无从下手,总是<FONT color=#ff0000>nothing</FONT>,我想有做过的朋友应该也知道.</FONT></P> <P>Public Sub LoadCadDrawingLayer()<br> Dim pMxDoc As IMxDocument<br> Dim pCadLayer As ICadLayer<br> Dim pCadDrawingDataset As ICadDrawingDataset<br> <br> Set pMxDoc = Application.Document<br> Set pCadDrawingDataset = GetCadDataset("d:\data\cad", "e-51878.dwg")<br> If pCadDrawingDataset Is Nothing Then Exit Sub<br> Set pCadLayer = New CadLayer<br> Set pCadLayer.CadDrawingDataset = pCadDrawingDataset<br> pCadLayer.Name = "e-51878.dwg" 'Give the map layer a name<br> pMxDoc.FocusMap.AddLayer pCadLayer<br> pMxDoc.UpdateContents 'Update the TOC<br>End Sub<br><br>Private Function GetCadDataset(strCadWorkspacePath As String, strCadFileName As String) As ICadDrawingDataset<br> Dim pName As IName<br> Dim pCadDatasetName As IDatasetName<br> Dim pWorkspaceName As IWorkspaceName<br> <br> On Error GoTo ErrorHandler<br> <br> 'Create a WorkspaceName object<br> Set pWorkspaceName = New WorkspaceName<br> pWorkspaceName.WorkspaceFactoryProgID = "esriDataSourcesFile.CadWorkspaceFactory"<br> pWorkspaceName.PathName = strCadWorkspacePath<br> <br> 'Create a CadDrawingName object<br> Set pCadDatasetName = New CadDrawingName<br> pCadDatasetName.Name = strCadFileName<br> Set pCadDatasetName.WorkspaceName = pWorkspaceName<br> <br> 'Open the CAD drawing<br> Set pName = pCadDatasetName 'QI<br> Set GetCadDataset = pName.Open<br> Exit Function<br> <br>ErrorHandler:<br> Set GetCadDataset = Nothing<br>End Function</DEVELOPENV><br></P> <P><FONT color=#ff0000>2.将它当做矢量层载入Mapcontrol</FONT></P> <P><DEVELOPENV>Public Sub LoadCadDrawingLayers()<br> Dim pMxDoc As IMxDocument<br> Dim pMap As IMap<br> Dim pCadWKSFact As IWorkspaceFactory<br> Dim pWorkspace As IFeatureWorkspace<br> Dim pCadFeatureLayer As IFeatureLayer<br> Dim pFeatureClass As IFeatureClass<br> Dim pFeatureDataset As IFeatureDataset<br> Dim pFeatureClassContainer As IFeatureClassContainer<br> Dim Count As Integer<br> <br> Set pMxDoc = Application.Document<br> Set pMap = pMxDoc.FocusMap<br><br> Set pCadWKSFact = New CadWorkspaceFactory<br> Set pWorkspace = pCadWKSFact.OpenFromFile("d:\data\cad", 0)<br> Set pFeatureDataset = pWorkspace.OpenFeatureDataset("e-51878.dwg")<br> Set pFeatureClassContainer = pFeatureDataset<br> For Count = 0 To pFeatureClassContainer.ClassCount - 1<br> Set pFeatureClass = pFeatureClassContainer.Class(Count)<br> 'Check for annotation<br> If pFeatureClass.FeatureType = esriFTCoverageAnnotation Then<br> Set pCadFeatureLayer = New CadAnnotationLayer<br> Else<br> Set pCadFeatureLayer = New CadFeatureLayer<br> End If<br> pCadFeatureLayer.Name = pFeatureClass.AliasName 'Give the map layer a name<br> Set pCadFeatureLayer.FeatureClass = pFeatureClass<br> pMap.AddLayer pCadFeatureLayer<br> Next Count<br> <br> pMxDoc.UpdateContents 'Refresh the TOC<br><br>End Sub<br></DEVELOPENV></P><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em01.gif" /> [此贴子已经被作者于2005-8-26 13:57:40编辑过]
|
|
|
1楼#
发布于：2007-08-17 09:23
<P><STRONG> 初学者向你致敬！</STRONG></P><img src="images/post/smile/dvbbs/em02.gif" />
|
|
|
2楼#
发布于：2007-08-16 11:43
<P>楼主真是好人，对我正有用，谢谢了</P>
|
|
