كيف يتم كتابة codes ضمن arcinfo .؟؟ليصبح اداة تحرير جديدة؟؟

[عبادة مالك]

السلام عليكم ...
سؤالي : لدي الكود التالي وهو يستخدم لفصل الخطوط في منطقة الاتصال مع النقاط...اي ان هنالك مجموعة من النقاط 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
..................

[بهجت يوسف الجعافرة]

السلام عليكم
اذا كنت تعرف topology
وعلاقة كل طبقة مع غيرها او مع نفسها
وما يسمى behavior
يمكن ب topology عمل ذالك

[نجد جمال]

السلام عليكم الاخ عبادة الكود يعمل بدقة وجودة عالية حيث انني قمت بتجربة الكود داخل بيئة ArcInfo

وكانت النتائج ايجابية والمكان المخصص للكود من خلال

Customize

الاخ عبادة الكود الذي بعثته هو عبارة عن

procedure

sub statement

يعني لا تاخذ متغيرات ويجب استدعاء هذا البروسيجر تحت كبسة


واستخدام الطبقات المناسبة


في النهاية الكود صحيح 100%

وشكرا




م.نجد جمال الحناحنه

[عبادة مالك]

اشكرك الاخ نجد ..
لكن هل تكرمت بالشرح التفصيلي عن طريقة اضافة هذا الكود ..حيث لم يسبق لي باضافة ذلك ...فكيف يتم ذلك من خلال
customize

[نجد جمال]

الاخ العزيز هذا فيديو يبين الية عمل الاداة وشكلها

http://sendinto.com/84l9o1uk1pzq/Costomization.exe.html



م.نجد جمال الحناحنه

[عبادة مالك]

اشكرك الاخ نجد ..لكن ..اريد الطريقة في صناعة هذه الاداة الجديدة ..كيف لي ان اضيف هذا الكود ..ما هي الطريقة لصناعة الكود ..

[نجد جمال]

الاخ عبادة هذا الشرح الكامل لكيفية تنزيل الاداة وتفعيلها

وقمت برفع فيديو يبن هذه العملية

PASSWORD

51B92KL


وهذا هو رابط الفيديو:

http://sendinto.com/1uoyk7lohxir/GIS_CUSTOM.exe.html


م.نجد جمال الحناحنه

[عبادة مالك]

جزاك الله خيرا ..لكن للاسف لم افلح بذلك ...ظهرت رسائل خطأ ..الرجاء فقط نسخ الكود في الرد ..كامل الكود الذي ينبغي علي اضافته ..حيث لاحظت ان هنالك عبارة في اول السطر كما هو مشروح في الفديو وهي عبارة غير موجودة في الكود الذي كتبته انا ....الرجاء اعادة نسخ كامل الكود من البداية الى نهايتة ..وارفع لك صورة تمثل رسالة الخطأ ..ولاحظ بداية الكود .اي اول سطر فيه فهل هذا صحيح ام علي اضافة سطر قبل كتابة الكود ...

[نجد جمال]

الاخ عبادة تحية طيبة وبعد:

في البداية الخطاء هو انك وضعت الكود خارج الكبسة فاذا لاحظت اني قمت بوضع كبسة اسمها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]