النتائج 1 إلى 9 من 9
  1. #1
    تاريخ التسجيل
    Oct 2008
    الدولة
    arab state
    المشاركات
    701

    كيف يتم كتابة 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
    ..................
    صلى الله عليك ياسيدي يارسول الله فصلوا عليه
  2. #2

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

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

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

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

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

    Customize

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

    procedure

    sub statement

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


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


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

    وشكرا




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

    مهندس جيوماتيكس

    Sr.GIS Engineer
    Pre-Sales GIS Engineer




  4. #4
    تاريخ التسجيل
    Oct 2008
    الدولة
    arab state
    المشاركات
    701

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

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

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

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

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



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

    مهندس جيوماتيكس

    Sr.GIS Engineer
    Pre-Sales GIS Engineer




  6. #6
    تاريخ التسجيل
    Oct 2008
    الدولة
    arab state
    المشاركات
    701

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

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

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

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

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

    PASSWORD

    51B92KL


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

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


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

    مهندس جيوماتيكس

    Sr.GIS Engineer
    Pre-Sales GIS Engineer




  8. #8
    تاريخ التسجيل
    Oct 2008
    الدولة
    arab state
    المشاركات
    701

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

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

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

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

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

    مهندس جيوماتيكس

    Sr.GIS Engineer
    Pre-Sales GIS Engineer




ضوابط المشاركة

  • لا تستطيع إضافة مواضيع جديدة
  • لا تستطيع الرد على المواضيع
  • لا تستطيع إرفاق ملفات
  • لا تستطيع تعديل مشاركاتك
  •