عبادة مالك
06-26-2010, 11:32 PM
السلام عليكم ...
سؤالي : لدي الكود التالي وهو يستخدم لفصل الخطوط في منطقة الاتصال مع النقاط...اي ان هنالك مجموعة من النقاط point تتصل تماما مع الخطوط والمطلوب هو فصل الخط split في نقطة الاتصال iintersect ...
فأين اكتب هذا الكود ضمن arcinfo ....
.................................................. .....
A gentleman in the Data Editing forum gave me this code to split all lines in one layer by all points in another. Note: It works funny while in an edit session. So, it is better to NOT Start Editing when using this code.
Brad
Sub SplitAll()
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Dim pPointL As IFeatureLayer
Set pPointL = pMap.Layer(0) 'point layer to split lines with
Dim pLineL As IFeatureLayer
Set pLineL = pMap.Layer(1) 'line layer to be split
Dim pLineFC As IFeatureClass
Set pLineFC = pLineL.FeatureClass
Dim pPointFC As IFeatureClass
Set pPointFC = pPointL.FeatureClass
Dim pPointCursor As IFeatureCursor
Set pPointCursor = pPointFC.Search(Nothing, False)
Dim pPointF As IFeature
Set pPointF = pPointCursor.NextFeature
Do Until pPointF Is Nothing
Dim pPoint As IPoint
Set pPoint = pPointF.Shape
Dim pSF As ISpatialFilter
Set pSF = New SpatialFilter
With pSF
Set .Geometry = pPoint
.GeometryField = "Shape"
.SpatialRel = esriSpatialRelIntersects
End With
Dim pLineCursor As IFeatureCursor
Set pLineCursor = pLineFC.Search(pSF, True)
Dim pLineF As IFeature
Set pLineF = pLineCursor.NextFeature
Do Until pLineF Is Nothing
Dim pPolyCurve As IPolycurve
Set pPolyCurve = pLineF.Shape
Dim pToPoint As IPoint
Set pToPoint = pPolyCurve.ToPoint
Dim pFromPoint As IPoint
Set pFromPoint = pPolyCurve.FromPoint
If (pFromPoint.x = pPoint.x And pFromPoint.y = pPoint.y) Then
'do nothing
ElseIf (pToPoint.x = pPoint.x And pToPoint.y = pPoint.y) Then
'do nothing
Else
Dim pFeatureEdit As IFeatureEdit
Set pFeatureEdit = pLineF
pFeatureEdit.Split pPointF.Shape
End If
Set pLineF = pLineCursor.NextFeature
Loop
Set pPointF = pPointCursor.NextFeature
Loop
End Sub
..................
سؤالي : لدي الكود التالي وهو يستخدم لفصل الخطوط في منطقة الاتصال مع النقاط...اي ان هنالك مجموعة من النقاط point تتصل تماما مع الخطوط والمطلوب هو فصل الخط split في نقطة الاتصال iintersect ...
فأين اكتب هذا الكود ضمن arcinfo ....
.................................................. .....
A gentleman in the Data Editing forum gave me this code to split all lines in one layer by all points in another. Note: It works funny while in an edit session. So, it is better to NOT Start Editing when using this code.
Brad
Sub SplitAll()
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Dim pPointL As IFeatureLayer
Set pPointL = pMap.Layer(0) 'point layer to split lines with
Dim pLineL As IFeatureLayer
Set pLineL = pMap.Layer(1) 'line layer to be split
Dim pLineFC As IFeatureClass
Set pLineFC = pLineL.FeatureClass
Dim pPointFC As IFeatureClass
Set pPointFC = pPointL.FeatureClass
Dim pPointCursor As IFeatureCursor
Set pPointCursor = pPointFC.Search(Nothing, False)
Dim pPointF As IFeature
Set pPointF = pPointCursor.NextFeature
Do Until pPointF Is Nothing
Dim pPoint As IPoint
Set pPoint = pPointF.Shape
Dim pSF As ISpatialFilter
Set pSF = New SpatialFilter
With pSF
Set .Geometry = pPoint
.GeometryField = "Shape"
.SpatialRel = esriSpatialRelIntersects
End With
Dim pLineCursor As IFeatureCursor
Set pLineCursor = pLineFC.Search(pSF, True)
Dim pLineF As IFeature
Set pLineF = pLineCursor.NextFeature
Do Until pLineF Is Nothing
Dim pPolyCurve As IPolycurve
Set pPolyCurve = pLineF.Shape
Dim pToPoint As IPoint
Set pToPoint = pPolyCurve.ToPoint
Dim pFromPoint As IPoint
Set pFromPoint = pPolyCurve.FromPoint
If (pFromPoint.x = pPoint.x And pFromPoint.y = pPoint.y) Then
'do nothing
ElseIf (pToPoint.x = pPoint.x And pToPoint.y = pPoint.y) Then
'do nothing
Else
Dim pFeatureEdit As IFeatureEdit
Set pFeatureEdit = pLineF
pFeatureEdit.Split pPointF.Shape
End If
Set pLineF = pLineCursor.NextFeature
Loop
Set pPointF = pPointCursor.NextFeature
Loop
End Sub
..................