Sub Test_break_blob()'create a file to save the broken information'it will be replaced by writing a database tablestrFilename = "C:\testBreakBlob.txt"
'need to set a reference to Microsoft Scripting LibraryDim FileSystem As FileSystemObject, TextStream As TextStreamSet FileSystem = CreateObject("Scripting.FileSystemObject")Set TextStream = FileSystem.CreateTextFile(strFilename)'set up the system'getting the layer and selectionset'in the future, we may consider write an AutoUpdater
Dim pMap As IMapDim pmxDoc As IMxDocumentSet pmxDoc = ThisDocumentSet pMap = pmxDoc.ActiveViewDim pftLayer As IFeatureLayerSet pftLayer = pMap.Layer(0) ' assume one layer, but in the future should find the layer from TOC
Dim pftClass As IFeatureClassSet pftClass = pftLayer.FeatureClassDim pfeat As IFeatureDim pftCursor As IFeatureCursor'getting all featuresSet pftCursor = pftClass.Search(Nothing, False)
Set pfeat = pftCursor.NextFeatureDo While Not (pfeat Is Nothing) 'finding the configuration field Dim pField As IField Dim nBlob As Long nBlob = pftClass.FindField("configuration") Set pField = pfeat.Fields.Field(nBlob)
'getting the value from Blob field Dim pBlob As IMemoryBlobStream Set pBlob = pfeat.Value(nBlob)
'create the duckbankconfig and ductview objecs Dim pDuctBankConfig As IMMDuctBankConfig Dim pDuctView As IMMDuctView Set pDuctBankConfig = New MMDuctBankConfig Set pDuctView = New MMDuctView 'asociate list objects with duct configuration object Dim pDuctBankConfigList As ID8List Dim pDuctViewList As ID8List Set pDuctViewList = pDuctView Set pDuctBankConfigList = pDuctBankConfig Dim pMMListItem As IMMPersistentListItem Set pMMListItem = pDuctBankConfigList 'load the blob into list objects pMMListItem.LoadFromStream pBlob Dim pDuctDefinition As IMMDuctDefinition
If Not (pDuctBankConfigList Is Nothing) Then 'And (Not IsNull(pDuctBankConfigList)) pDuctBankConfigList.Reset Do Set pDuctViewList = pDuctBankConfigList.Next If Not (pDuctViewList Is Nothing) Then 'And (Not IsNull(pDuctViewList)) pDuctViewList.Reset Do Set pDuctDefinition = pDuctViewList.Next If Not (pDuctDefinition Is Nothing) Then 'And (Not IsNull(pDuctDefinition)) 'MsgBox pfeat.OID & "-" & pDuctDefinition.availability & "-" & pDuctDefinition.ductID & "-" & pDuctDefinition.diameter TextStream.WriteLine pfeat.OID & "," & pDuctDefinition.availability & "," & pDuctDefinition.ductID & "," & pDuctDefinition.diameter & "," & pDuctDefinition.ductNumber & "," & pDuctDefinition.Material pductdefinition. End If Loop While Not (pDuctDefinition Is Nothing) ' And (Not IsNull(pDuctDefinition)) End If Loop While Not (pDuctViewList Is Nothing) ' And (Not IsNull(pDuctViewList)) End If Set pDuctView = Nothing Set pDuctBankConfig = Nothing Set pBlob = Nothing Set pfeat = pftCursor.NextFeatureLoopTextStream.CloseSet TextStream = NothingSet FileSystem = NothingEnd Sub
'need to set a reference to Microsoft Scripting LibraryDim FileSystem As FileSystemObject, TextStream As TextStreamSet FileSystem = CreateObject("Scripting.FileSystemObject")Set TextStream = FileSystem.CreateTextFile(strFilename)'set up the system'getting the layer and selectionset'in the future, we may consider write an AutoUpdater
Dim pMap As IMapDim pmxDoc As IMxDocumentSet pmxDoc = ThisDocumentSet pMap = pmxDoc.ActiveViewDim pftLayer As IFeatureLayerSet pftLayer = pMap.Layer(0) ' assume one layer, but in the future should find the layer from TOC
Dim pftClass As IFeatureClassSet pftClass = pftLayer.FeatureClassDim pfeat As IFeatureDim pftCursor As IFeatureCursor'getting all featuresSet pftCursor = pftClass.Search(Nothing, False)
Set pfeat = pftCursor.NextFeatureDo While Not (pfeat Is Nothing) 'finding the configuration field Dim pField As IField Dim nBlob As Long nBlob = pftClass.FindField("configuration") Set pField = pfeat.Fields.Field(nBlob)
'getting the value from Blob field Dim pBlob As IMemoryBlobStream Set pBlob = pfeat.Value(nBlob)
'create the duckbankconfig and ductview objecs Dim pDuctBankConfig As IMMDuctBankConfig Dim pDuctView As IMMDuctView Set pDuctBankConfig = New MMDuctBankConfig Set pDuctView = New MMDuctView 'asociate list objects with duct configuration object Dim pDuctBankConfigList As ID8List Dim pDuctViewList As ID8List Set pDuctViewList = pDuctView Set pDuctBankConfigList = pDuctBankConfig Dim pMMListItem As IMMPersistentListItem Set pMMListItem = pDuctBankConfigList 'load the blob into list objects pMMListItem.LoadFromStream pBlob Dim pDuctDefinition As IMMDuctDefinition
If Not (pDuctBankConfigList Is Nothing) Then 'And (Not IsNull(pDuctBankConfigList)) pDuctBankConfigList.Reset Do Set pDuctViewList = pDuctBankConfigList.Next If Not (pDuctViewList Is Nothing) Then 'And (Not IsNull(pDuctViewList)) pDuctViewList.Reset Do Set pDuctDefinition = pDuctViewList.Next If Not (pDuctDefinition Is Nothing) Then 'And (Not IsNull(pDuctDefinition)) 'MsgBox pfeat.OID & "-" & pDuctDefinition.availability & "-" & pDuctDefinition.ductID & "-" & pDuctDefinition.diameter TextStream.WriteLine pfeat.OID & "," & pDuctDefinition.availability & "," & pDuctDefinition.ductID & "," & pDuctDefinition.diameter & "," & pDuctDefinition.ductNumber & "," & pDuctDefinition.Material pductdefinition. End If Loop While Not (pDuctDefinition Is Nothing) ' And (Not IsNull(pDuctDefinition)) End If Loop While Not (pDuctViewList Is Nothing) ' And (Not IsNull(pDuctViewList)) End If Set pDuctView = Nothing Set pDuctBankConfig = Nothing Set pBlob = Nothing Set pfeat = pftCursor.NextFeatureLoopTextStream.CloseSet TextStream = NothingSet FileSystem = NothingEnd Sub
No comments:
Post a Comment