تطبيقات برمجة أوتوكاد - التطبيق الرابع - استبدال كائنات

المستوى

مبتدئ

المهارات المطلوبة لفهم الموضوع

معرفة بسيطة باستخدام برنامج أوتوكاد.
معرفة بالأوامر الأساسية للغة البرمجة Visual Basic.

مقدمة

راسلني أحد الإخوة منذ مدة يريد مني أن أدله على أمر في أوتوكاد أو برنامج يقوم باستبدال كائنات من النوع (سمة - Attribute) بكائنات نصية من النوع (نص - Text) بحيث لا تؤثر على شكل الرسم.

كان في اللوحة الأساسية عشرات من هذه الكائنات، ولا أدري كم كان عدد اللوحات الكلي، ومن الصعب إجراء هذه العملية يدوياً فقد تأخذ ساعات.

في الحقيقة لا أعلم إن كان هناك أمر داخلي في أوتوكاد يقوم بهذا، ولا أعلم إن كان هناك برنامج خارجي يؤدي هذه المهمة، فمارست هوايتي بكتابة برنامج صغير وأرسلته له، ورأيت أن أضيفه هنا مع شرح مبسط عنه، لا لأنه قد يكون مفيداً للآخرين، لكن لتوضيح كيف يمكن كتابة برنامج صغير قد لا يستغرق ربع ساعة، فيؤدي مهمة قد تستغرق ساعات، هذا غير الملل الذي قد يؤدي إلى أخطاء.

قد يتساءل أحدنا، ما الفائدة من هذا البرنامج؟

في الحقيقة أنا لم أسأله، وليس المهم في هذا التمرين أن نعلم الفائدة من هذا البرنامج بالتحديد، لكن ما أعلمه أنه كان بحاجة لمثل هذا البرنامج، ويكفي في هذا التمرين أن نعلم أنه يمكن باستخدام برمجة بسيطة أن نقوم بأعمال قد نعجز عن القيام بها يدوياً أو تأخذ منا وقتاً طويلاً.

جانب من اللوحة والنتيجة المطلوبة

هذا جزء صغير من اللوحة التي أرسلها الأخ، يكفي لتوضيح الفكرة.

في الجزء الأيمن من الصورة، كائنات أوتوكاد من النوع (سمة - Attribute) باللون السماوي وهي اللوحة الأصلية، وفي الجزء الأيسر كائنات (نص - Text) بعد تنفيذ البرنامج. يجب أن تكون النتيجة نفسها.

الشكل (4-1): الكائنات باللون السماوي كانت من النوع Attribute وتم تحويلها إلى Text.

كيف يعمل البرنامج

يقوم البرنامج أولاً بإنشاء طبقة جديدة (إن لم تكن موجودة مسبقاً) ليضع فيها كائنات ال Attributes القديمة بدلاً من حذفها لنتأكد من أن العمل الذي قام به صحيح، بعد هذا يمكننا حذف هذه الكائنات يدوياً.

ثم يقوم بالبحث ضمن اللوحة عن جميع كائنات Attribute فيقرأ القيمة المخزنة فيها ويقرأ الخصائص اللازمة (نمط الخط - حجم الخط - نقطة الإدراج - المحاذاة - الطبقة - اللون - ... إلخ) ثم يقوم بإنشاء كائن جديد من النوع Text له نفس هذه الخصائص، وينقل كائنات ال Attributes إلى الطبقة التي قام بإنشائها.

يقوم البرنامج أيضاً بعد الكائنات التي قام باستبدالها، وفي النهاية يظهر رسالة الانتهاء مع العدد.

البرنامج

قمت بإضافة الشرح ضمن البرنامج، ولا أظن أنه يحتاج شرحاً أكثر فهو بسيط.

Public Sub ReplaceAttributesWithTexts()
    If MsgBox("Are you sure you want to replace attributes with texts?", _
                vbYesNo Or vbQuestion) = vbNo Then Exit Sub

    Dim ent As AcadEntity, Count As Integer

    'إضافة الطبقة التي سيتم وضع الكائنات القديمة فيها
    Dim OldAttLayer As String
    OldAttLayer = "OldAttLayer"
    On Error Resume Next
    ThisDrawing.Layers.Add OldAttLayer
    On Error GoTo 0

    'التنقل بين جميع الكائنات
    For Each ent In ThisDrawing.ModelSpace
        'إن كان الكائن من النوع (سمة) وكانت طبقته ليست طبقة الكائنات
        'القديمة سنقوم باستبداله
        If TypeOf ent Is AcadAttribute And ent.Layer <> OldAttLayer Then
            Dim att As AcadAttribute
            Set att = ent
            Dim t As AcadText

            'إضافة كائن جديد من نوع (نص) وتعديل خصائصه بما يتطابق
            'مع خصائص الكائن القديم
            Set t = ThisDrawing.ModelSpace.AddText(att.TagString, _
                att.InsertionPoint, att.Height)
            t.Alignment = att.Alignment
            t.Layer = att.Layer
            t.StyleName = att.StyleName
            t.ScaleFactor = att.ScaleFactor
            t.TrueColor = att.TrueColor

            'نقل الكائن القديم إلى طبقة الكائنات القديمة
            att.Layer = OldAttLayer
            Count = Count + 1
        End If
    Next

    MsgBox Count & " attributes have been replaced.", vbInformation
End Sub

تحميل

مشروع VBA، مع ملف الأوتوكاد التوضيحي.