用AO实现ACAD到Geodatabase的转换

最新推荐文章于 2024-02-29 17:24:19 发布

habit2

最新推荐文章于 2024-02-29 17:24:19 发布

阅读量1.6k

点赞数

分类专栏：测绘&GIS 文章标签： database command object

本文链接：https://blog.csdn.net/habit2/article/details/599167

版权

测绘&GIS 专栏收录该内容

4 篇文章 0 订阅

订阅专栏

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