from VBA to VB

643
0
01-27-2012 05:46 AM
MarAlcaraz1
New Contributor
Hi,

I'm trying to create a command in arcgis 10 following the walkthrough. The solution is built succesfully but I get this message when I start debugging:

A first chance exception of type 'System.InvalidCastException' occurred in firstcommand.dll


This command would divide a shapefile according a number of features.  Any idea?

This is the code of .vb file:


Imports System.Runtime.InteropServices
Imports System.Drawing
Imports ESRI.ArcGIS.ADF.BaseClasses
Imports ESRI.ArcGIS.ADF.CATIDs
Imports ESRI.ArcGIS.Framework
Imports ESRI.ArcGIS.ArcMapUI
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.GeoDatabaseUI



<ComClass(firstcommand.ClassId, firstcommand.InterfaceId, firstcommand.EventsId), _
 ProgId("FirstCommand.firstcommand")> _
Public NotInheritable Class firstcommand
    Inherits BaseCommand

#Region "COM GUIDs"
    ' These  GUIDs provide the COM identity for this class 
    ' and its COM interfaces. If you change them, existing 
    ' clients will no longer be able to access the class.
    Public Const ClassId As String = "2944c100-f55a-45dd-9b9d-d9cb1c67c2ef"
    Public Const InterfaceId As String = "2c2297a1-0661-4820-acb3-963d030026be"
    Public Const EventsId As String = "52e066f2-90fc-4cc2-af82-24d17a4079f2"
#End Region

#Region "COM Registration Function(s)"
    <ComRegisterFunction(), ComVisibleAttribute(False)> _
    Public Shared Sub RegisterFunction(ByVal registerType As Type)
        ' Required for ArcGIS Component Category Registrar support
        ArcGISCategoryRegistration(registerType)

        'Add any COM registration code after the ArcGISCategoryRegistration() call

    End Sub

    <ComUnregisterFunction(), ComVisibleAttribute(False)> _
    Public Shared Sub UnregisterFunction(ByVal registerType As Type)
        ' Required for ArcGIS Component Category Registrar support
        ArcGISCategoryUnregistration(registerType)

        'Add any COM unregistration code after the ArcGISCategoryUnregistration() call

    End Sub

#Region "ArcGIS Component Category Registrar generated code"
    Private Shared Sub ArcGISCategoryRegistration(ByVal registerType As Type)
        Dim regKey As String = String.Format("HKEY_CLASSES_ROOT\CLSID\{{{0}}}", registerType.GUID)
        MxCommands.Register(regKey)

    End Sub
    Private Shared Sub ArcGISCategoryUnregistration(ByVal registerType As Type)
        Dim regKey As String = String.Format("HKEY_CLASSES_ROOT\CLSID\{{{0}}}", registerType.GUID)
        MxCommands.Unregister(regKey)

    End Sub

#End Region
#End Region


    Private m_application As IApplication

    ' A creatable COM class must have a Public Sub New() 
    ' with no parameters, otherwise, the class will not be 
    ' registered in the COM registry and cannot be created 
    ' via CreateObject.
    Public Sub New()
        MyBase.New()

        ' TODO: Define values for the public properties
        MyBase.m_category = "MDM"  'localizable text 
        MyBase.m_caption = "SplitSHPcommand"   'localizable text 
        MyBase.m_message = ""   'localizable text 
        MyBase.m_toolTip = "Split SHP" 'localizable text 
        MyBase.m_name = "MDM_SplitSHPcommand"  'unique id, non-localizable (e.g. "MyCategory_ArcMapCommand")

        Try
            'TODO: change bitmap name if necessary
            Dim bitmapResourceName As String = Me.GetType().Name + ".bmp"
            MyBase.m_bitmap = New Bitmap(Me.GetType(), bitmapResourceName)
        Catch ex As Exception
            System.Diagnostics.Trace.WriteLine(ex.Message, "Invalid Bitmap")
        End Try


    End Sub


    Public Overrides Sub OnCreate(ByVal hook As Object)
        If Not hook Is Nothing Then
            m_application = CType(hook, IApplication)

            'Disable if it is not ArcMap
            If TypeOf hook Is IMxApplication Then
                MyBase.m_enabled = True
            Else
                MyBase.m_enabled = False
            End If
        End If

        ' TODO:  Add other initialization code
    End Sub

    Public Overrides Sub OnClick()



        Dim pMxDoc As IMxDocument
        pMxDoc = m_application

        Dim pMap As IMap
        pMap = pMxDoc.FocusMap

        Dim pFLayer As IFeatureLayer
        pFLayer = pMap.Layer(0)

        Dim pFeatSel As IFeatureSelection
        pFeatSel = pFLayer

        Dim pFeatClass As IFeatureClass
        pFeatClass = pFLayer.FeatureClass

        Dim pDataset As IDataset
        pDataset = pFeatClass

        Dim sPath As String
        sPath = pDataset.Workspace.PathName & "\"

        Dim pINFeatureClassName As IFeatureClassName
        pINFeatureClassName = pDataset.FullName

        Dim pInDsName As IDatasetName
        pInDsName = pINFeatureClassName

        Dim Size As Integer
        Size = InputBox("Size of shapefile")
        MkDir(sPath & "\Split_" & pDataset.Name & Size)

        For j = 0 To pFeatClass.FeatureCount(Nothing) Step Size - 1

            For i = j To j + Size - 1
                Dim pFeat As IFeature
                On Error Resume Next
                pFeat = pFeatClass.GetFeature(i)
                pFeatSel.Add(pFeat)
            Next

            Dim pSelSet As ISelectionSet
            pSelSet = pFeatSel.SelectionSet

            'Define the output feature class name

            Dim pFeatureClassName As IFeatureClassName
            pFeatureClassName = New FeatureClassName

            Dim pOutDatasetName As IDatasetName
            pOutDatasetName = pFeatureClassName

            pOutDatasetName.Name = "Export_" & j

            Dim pWorkspaceName As IWorkspaceName
            pWorkspaceName = New WorkspaceName

            pWorkspaceName.PathName = sPath & "\Split_" & pDataset.Name & Size 

            pWorkspaceName.WorkspaceFactoryProgID = "esriCore.shapefileworkspacefactory.1"

            pOutDatasetName.WorkspaceName = pWorkspaceName

            pFeatureClassName.FeatureType = esriFeatureType.esriFTSimple

            pFeatureClassName.ShapeType = esriGeometryType.esriGeometryAny

            pFeatureClassName.ShapeFieldName = "Shape"

            Dim pExportOp As IExportOperation
            pExportOp = New ExportOperation

            pExportOp.ExportFeatureClass(pInDsName, Nothing, pSelSet, Nothing, pOutDatasetName, 0)

            pFeatSel.Clear()

        Next


    End Sub
End Class
0 Kudos
0 Replies