用AO实现ACAD到Geodatabase的转换

Private Sub Command1_Click()
Dim pWorkspaceFact As IWorkspaceFactory
Dim pWorkspace As IWorkspace
Dim myFWS As IFeatureWorkspace
Dim myFDS As IFeatureDataset
Dim myFCContainer As IFeatureClassContainer
Dim inDataName As IDatasetName
Dim inFDataName As IFeatureDatasetName
Dim inEnumDS_FC As IEnumDatasetName

Dim pOutAcFact As IWorkspaceFactory
Dim pOutAcWorkspaceName As IWorkspaceName
Dim pOutAcFeatDSName As IFeatureDatasetName
Dim pOutAcDSName As IDatasetName
Dim outFDS As IFeatureDataset
Dim pPropset As IPropertySet
Dim pName As IName

Dim theLayer As IFeatureLayer
Dim myFDC As IFeatureDataConverter

Set pPropset = New PropertySet
pPropset.SetProperty "Database", "F:/szhh/canada"
Set pOutAcFact = New AccessWorkspaceFactory
Set pOutAcWorkspaceName = pOutAcFact.Create("F:/szhh/canada", "canada", pPropset, Form1.hWnd)
Set pOutAcFeatDSName = New FeatureDatasetName
Set pOutAcDSName = pOutAcFeatDSName
Set pOutAcDSName.WorkspaceName = pOutAcWorkspaceName
pOutAcDSName.Name = "Country"
Set pName = pOutAcFeatDSName
'Set outFDS = pName.Open

Set myFDC = New FeatureDataConverter

Set pWorkspaceFact = New CadWorkspaceFactory
Set pWorkspace = pWorkspaceFact.OpenFromFile("F:/szhh", Form1.hWnd)
Set myFWS = pWorkspace
Set myFDS = myFWS.OpenFeatureDataset("aaa.dwg")
Set myFCContainer = myFDS
Set inDataName = myFDS.FullName
Set inFDataName = inDataName
Set inEnumDS_FC = inFDataName.FeatureClassNames
inEnumDS_FC.Reset

Dim inDSname As IDatasetName
Dim myFCname As IFeatureClassName
Set inDSname = inEnumDS_FC.Next
Set theLayer = Nothing
While Not inDSname Is Nothing
Set myFCname = inDSname
If inDSname.Name = "Annotation" Then
Set theLayer = New CadAnnotationLayer
Else
Set theLayer = New CadFeatureLayer
End If

Dim myFCL As IFeatureClass
Dim ShapeField As IField
Dim myGeom As IGeometryDef
theLayer.Name = inDSname.Name
Set myFCL = myFCContainer.ClassByName(inDSname.Name)
Set ShapeField = myFCL.Fields.Field(myFCL.FindField(myFCL.ShapeFieldName))
Set myGeom = ShapeField.GeometryDef

Dim myFilter As IQueryFilter
Set myFilter = New QueryFilter
myFilter.SubFields = "*"

' Dim myInGeo As IGeoDataset
' Set myInGeo = myFDS
' Dim myInRef As ISpatialReference
' Set myInRef = myInGeo.SpatialReference
' Dim inXMin As Double
' Dim inXMax As Double
' Dim inYMin As Double
' Dim inYMax As Double
' inXMin = 0
' inXMax = 0
' inYMin = 0
' inYMax = 0
' myInRef.GetDomain inXMin, inXMax, inYMin, inYMax
'
' Dim myOutGeo As IGeoDataset
' Set myOutGeo = outFDS
' Dim myOutRef As ISpatialReference
' Set myOutRef = myOutGeo.SpatialReference
' Dim outXMin As Double
' Dim outXMax As Double
' Dim outYMin As Double
' Dim outYMax As Double
' outXMin = 0
' outXMax = 0
' outYMin = 0
' outYMax = 0
' myOutRef.GetDomain outXMin, outXMax, outYMin, outYMax
'
' Dim newXMin As Double, newXMax As Double, newYMin As Double, newYMax As Double
' If inXMin < outXMin Then newXMin = inXMin Else newXMin = outXMin
' If inXMax > outXMax Then newXMax = inXMax Else newXMax = outXMax
' If inYMin < outYMin Then newYMin = inYMin Else newYMin = outYMin
' If inYMax > outYMax Then newYMax = inYMax Else newYMax = outYMax
' myOutRef.SetDomain newXMin, newXMax, newYMin, newYMax

Dim myEnumInv As IEnumInvalidObject
Set myEnumInv = myFDC.ConvertFeatureClass(myFCname, myFilter, pOutAcFeatDSName, myFCname, myGeom, myFCL.Fields, "", 1000, Form1.hWnd)
myEnumInv.Reset
Dim myInv As IInvalidObjectInfo
While Not myInv Is Nothing
MsgBox "Invalid Object #" & myInv.InvalidObjectID & myInv.ErrorDescription
Set myInv = myEnumInv.Next
Wend
Set inDSname = inEnumDS_FC.Next
Wend
End Sub