Set the class extension for an existing object class


Description:

Implementing a class extension is an ideal way to extend the default geodatabase behavior. This VBA script lets you set the class extension of an existing feature class or object class. To do this you must have already implemented a class extension suitable for the dataset. You should be cautious when using this script, since incorrectly applying class extensions can lead to unexpected behavior.
Products:
ArcView: VBA, VB6

Platforms: Windows

Minimum ArcGIS Release: 9.0

How to use:
  1. Paste the code into the ArcCatalog VBA environment.
  2. Find the CLSID of the class extension you have developed. To do this search the registry for the name of your class and copy the CLSID to the clipboard.
  3. In ArcCatalog, select the appropriate feature class or object class, then run the script
  4. Paste in the CLSID, and press OK.
  5. If you enter the string 'Nothing' instead of a CLSID, any current class extension will be cleared. If you press Cancel, the current CLSID will be shown. 
Public Sub SetClassExtension()

  Dim pGxApp As IGxApplication
  Set pGxApp = Application
  
  Dim pGxObject As IGxObject
  If (pGxObject Is Nothing) Then
    Set pGxObject = pGxApp.SelectedObject
  End If
  
  If Not (TypeOf pGxObject Is IGxDataset) Then Exit Sub
    
  Dim pGxDataset As IGxDataset
  Set pGxDataset = pGxObject ' QI
  
  If Not (TypeOf pGxDataset.Dataset Is IClass) Then Exit Sub
    
  Dim pClass As IClass
  Set pClass = pGxDataset.Dataset
  
  Dim strGUID As String
  strGUID = InputBox("Enter GUID", "Set class extension for " & pGxObject.Name)
  If Len(strGUID) <> 38 And UCase(strGUID) <> "NOTHING" Then
    ' Show the current extension
    Dim strCurrent As String
    If pClass.EXTCLSID Is Nothing Then
      strCurrent = "Current class extension is nothing"
    Else
      strCurrent = "Current class extension is: " & pClass.EXTCLSID
    End If
    MsgBox "No valid GUID entered." & vbNewLine & strCurrent
    Exit Sub
  End If
      

  Dim pUID As New UID
  If UCase(strGUID) = "NOTHING" Then
    Set pUID = Nothing
  Else
    pUID.Value = strGUID
  End If
  
  Dim pClassSchemaEdit As IClassSchemaEdit
  Set pClassSchemaEdit = pClass
  Dim pSchemaLock As ISchemaLock
  Set pSchemaLock = pClassSchemaEdit
  pSchemaLock.ChangeSchemaLock esriExclusiveSchemaLock
  pClassSchemaEdit.AlterClassExtensionCLSID pUID, Nothing
  pSchemaLock.ChangeSchemaLock esriSharedSchemaLock
  
  MsgBox "Class extension changed for " & pGxObject.Name
  
End Sub