الاخ عبادة تحية طيبة وبعد:
في البداية الخطاء هو انك وضعت الكود خارج الكبسة فاذا لاحظت اني قمت بوضع كبسة اسمهاPrivate Sub UIButtonControl1
الاخ عبادة ضع الكود في الداخل:
[align=center]Private Sub UIButtonControl1_Click()
[all1=#3E804A][align=center]الكود هنا[/align][/all1]End Sub[/align]
وهذا الكود
:
[all1=#FF4D00]Private Sub UIButtonControl1_Click()[/all1]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
[all1=#FF3600]End Sub[/all1]
رد مع اقتباس