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

النقاط الأساسية

نص التطبيق
فكرة الحل
الحل
الوصول إلى حل مختصر
خاتمة

نص التمرين

المطلوب رسم الشكل التالي (من دون الأبعاد التوضيحية) بواسطة VBA مع مراعاة ما يلي:

إنشاء ملف جديد
رسم الشكل ابتداءً من الزاوية اليسرى السفلى الواقعة في مبدأ الإحداثيات، وبجهة عقارب الساعة.
حفظ الملف باسم Tutorial.dwg في الدليل الجذري للسواقة C:

فكرة الحل

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

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

الحل

أضف وحدة نمطية جديدة Module ثم أضف الماكرو التالي:

Public Sub Tutorial01()

    'تعريف متحولات الإحداثيات لبداية ونهاية الخطوط ومركز الدائرة
    Dim StartPoint(0 To 2) As Double
    Dim EndPoint(0 To 2) As Double
    Dim CenterPoint(0 To 2) As Double

    'تعريف المتحولات لكائن الخط وكائن الدائرة
    Dim lineObj As AcadLine
    Dim circleObj As AcadCircle

    'إضافة لوحة جديدة
    Application.Documents.Add

    'إضافة الخطوط
    StartPoint(0) = 0: StartPoint(1) = 0: StartPoint(2) = 0
    EndPoint(0) = 0: EndPoint(1) = 100: EndPoint(2) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)
    lineObj.Color = acBlue

    StartPoint(0) = 0: StartPoint(1) = 100
    EndPoint(0) = 100: EndPoint(1) = 200
    Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)
    lineObj.Color = acBlue

    StartPoint(0) = 100: StartPoint(1) = 200
    EndPoint(0) = 200: EndPoint(1) = 200
    Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)
    lineObj.Color = acBlue

    StartPoint(0) = 200: StartPoint(1) = 200
    EndPoint(0) = 200: EndPoint(1) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)
    lineObj.Color = acBlue

    StartPoint(0) = 200: StartPoint(1) = 0
    EndPoint(0) = 0: EndPoint(1) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)
    lineObj.Color = acBlue

    'إضافة الدائرة
    CenterPoint(0) = 110: CenterPoint(1) = 90: CenterPoint(2) = 0
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(CenterPoint, 50)
    circleObj.Color = acRed

    'تقريب أو تبعيد المعاينة إلى الحدود
    Application.ZoomExtents

    'حفظ الملف
    ThisDrawing.SaveAs "c:\Tutorial.dwg"

End Sub

الوصول إلى حل مختصر

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

ومن طرق الاختصار أن نقوم بإنشاء إجراء جديد لإضافة الخط ونسميه مثلاً myAddLine وإجراء آخر لإضافة دائرة ونسميه myAddCircle ونمرر لكل من الإجرائين المعطيات اللازمة للرسم من إحداثيات ولون ونصف قطر.

فيصبح البرنامج بالشكل التالي:

Public Sub Tutorial01b()

    'إضافة لوحة جديدة
    Application.Documents.Add

    'إضافة الخطوط
    myAddLine 0, 0, 0, 100, acBlue
    myAddLine 0, 100, 100, 200, acBlue
    myAddLine 100, 200, 200, 200, acBlue
    myAddLine 200, 200, 200, 0, acBlue
    myAddLine 200, 0, 0, 0, acBlue

    'إضافة الدائرة
    myAddCircle 110, 90, 50, acRed

    'تقريب أو تبعيد المعاينة إلى الحدود
    Application.ZoomExtents

    'حفظ الملف
    ThisDrawing.SaveAs "c:\Tutorial.dwg"

End Sub

Private Sub myAddLine(x1 As Double, y1 As Double, x2 As Double, _
            y2 As Double, Color As Integer)

    Dim lineObj As AcadLine
    Dim StartPoint(0 To 2) As Double, EndPoint(0 To 2) As Double
    StartPoint(0) = x1: StartPoint(1) = y1
    EndPoint(0) = x2: EndPoint(1) = y2
    Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)
    lineObj.Color = Color

End Sub

Private Sub myAddCircle(x As Double, y As Double, r As Double, _
            Color As Integer)

    Dim circleObj As AcadCircle
    Dim CenterPoint(0 To 2) As Double
    CenterPoint(0) = x: CenterPoint(1) = y
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(CenterPoint, r)
    circleObj.Color = Color

End Sub

تحميل

مشروع المثال