۱۲-۰۱-۱۳۹۳، ۱۱:۰۳ ب.ظ
با سلام خدمت شما، هرچند شاید اینجا مطرح کردن سوال تخصصی مناسب نباشد ولی جایی در سایت ندیدم برا همین اینجا مطرح می کنم، ابتداً از راهنماییتان مچکرم
بنده یک فایل نقطه ای دارم که در کل استان قزوین پخش شده است. در این لایه مقادیر یکی از فیلدها هر روز آپدیت می شود که این مقادیر براساس فیلد پهنه موجود در لایه صورت می پیرد. که برای اینکه سرعت کار بالا رود یک کد نوشته ام که در یک کمبو باکس نوشته شده و کابر با انتخاب پهنه ها در این کمبوباکس و سپس از طریق یک اینپوتباکس مقادیر جدید فیلدهای متناظر را وارد کرده و بدینگونه دیگر نیازی به استفاده از استارت إدیتینگ و.. نمی باشد. ولی کد بنده إرور می دهد ولی با بررسی فراوان نتوانستم علت اجرا نشدن آن را بدانم.اگر امکانش هست بنده را راهنمایی فرمائید.
Private Sub UIComboBoxControl1_SelectionChange(ByVal newIndex As Long)
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMaps As IMaps
Set pMaps = pMxDoc.Maps
Dim pqazvinMap As IMap
Set pqazvinMap = pMaps.Item(0)
Dim pkolLayerDef As IFeatureLayerDefinition
Set pkolLayerDef = pqazvinMap.Layer(0)
Dim strQuery As String
strQuery = "State_Name = '" & UIComboBoxControl1.EditText & "'"
Dim pEPAActiveView As IActiveView
Set pEPAActiveView = pqazvinMap
pkolLayerDef.DefinitionExpression = strQuery
Dim pFilter As IQueryFilter
Set pFilter = New QueryFilter
pFilter.WhereClause = strQuery
Dim pkolFLayer As IFeatureLayer
Set pkolFLayer = pkolLayerDef
Dim pkolFClass As IFeatureClass
Set pkolFClass = pkolFLayer.FeatureClass
Dim pSelectionSet As ISelectionSet
Set pSelectionSet = pkolFClass.Select _
(pFilter, _
esriSelectionTypeHybrid, _
esriSelectionOptionNormal, _
Nothing)
Dim pkolFClasss As IFeatureSelection
Set pkolFClasss = pkolFLayer
Set pkolFClasss.SelectionSet = pSelectionSet
Dim pFLayer As IFeatureLayer
Set pFLayer = pMxDoc.ContextItem
Dim pFields As IFields
Set pFields = pkolFClass.Fields
Dim pFCursor As IFeatureCursor
Set pFCursor = pkolFClass.Update(pFilter, True)
Dim pFeature As IFeature
Set pFeature = pFCursor.NextFeature
Do Until pFeature Is pFilter
X = InputBox("شماره جديد")
pFeature.Value(3) = X
Set pFeature = pFCursor.NextFeature
pFCursor.UpdateFeature pFeature
Loop
pMxDoc.ActiveView.Refresh
pMxDoc.UpdateContents
End Sub
بنده یک فایل نقطه ای دارم که در کل استان قزوین پخش شده است. در این لایه مقادیر یکی از فیلدها هر روز آپدیت می شود که این مقادیر براساس فیلد پهنه موجود در لایه صورت می پیرد. که برای اینکه سرعت کار بالا رود یک کد نوشته ام که در یک کمبو باکس نوشته شده و کابر با انتخاب پهنه ها در این کمبوباکس و سپس از طریق یک اینپوتباکس مقادیر جدید فیلدهای متناظر را وارد کرده و بدینگونه دیگر نیازی به استفاده از استارت إدیتینگ و.. نمی باشد. ولی کد بنده إرور می دهد ولی با بررسی فراوان نتوانستم علت اجرا نشدن آن را بدانم.اگر امکانش هست بنده را راهنمایی فرمائید.
Private Sub UIComboBoxControl1_SelectionChange(ByVal newIndex As Long)
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMaps As IMaps
Set pMaps = pMxDoc.Maps
Dim pqazvinMap As IMap
Set pqazvinMap = pMaps.Item(0)
Dim pkolLayerDef As IFeatureLayerDefinition
Set pkolLayerDef = pqazvinMap.Layer(0)
Dim strQuery As String
strQuery = "State_Name = '" & UIComboBoxControl1.EditText & "'"
Dim pEPAActiveView As IActiveView
Set pEPAActiveView = pqazvinMap
pkolLayerDef.DefinitionExpression = strQuery
Dim pFilter As IQueryFilter
Set pFilter = New QueryFilter
pFilter.WhereClause = strQuery
Dim pkolFLayer As IFeatureLayer
Set pkolFLayer = pkolLayerDef
Dim pkolFClass As IFeatureClass
Set pkolFClass = pkolFLayer.FeatureClass
Dim pSelectionSet As ISelectionSet
Set pSelectionSet = pkolFClass.Select _
(pFilter, _
esriSelectionTypeHybrid, _
esriSelectionOptionNormal, _
Nothing)
Dim pkolFClasss As IFeatureSelection
Set pkolFClasss = pkolFLayer
Set pkolFClasss.SelectionSet = pSelectionSet
Dim pFLayer As IFeatureLayer
Set pFLayer = pMxDoc.ContextItem
Dim pFields As IFields
Set pFields = pkolFClass.Fields
Dim pFCursor As IFeatureCursor
Set pFCursor = pkolFClass.Update(pFilter, True)
Dim pFeature As IFeature
Set pFeature = pFCursor.NextFeature
Do Until pFeature Is pFilter
X = InputBox("شماره جديد")
pFeature.Value(3) = X
Set pFeature = pFCursor.NextFeature
pFCursor.UpdateFeature pFeature
Loop
pMxDoc.ActiveView.Refresh
pMxDoc.UpdateContents
End Sub