سؤال إلى الخبراء في البيسك والأوتوكاد لترتيب مستطيلات في مستطيل يحويها

الهندسة المدنية برنامج الأوتوكاد
1

هل من عبقري يساعدني في طرف الخيط لإنشاء كود ترتيب مستطيلات في مستطيل 

					 						 				 					 						[B] 							السلام عليكم

هل من عبقري يساعدني في طرف الخيط لإنشاء كود ترتيب مستطيلات في مستطيل بواسطة فيجوال بيسك
والأوتوكاد؟
مثال:
مستطيلات عشوائية
لها أطوال أصغر من Y
ولها عروض أصغر من X
ومستطيل كبير طوله Y وعرضه X
أريد صف المستطيلات العشوائية في المستطيل الكبير بحيث يكون الصف مثالي ( مساحة ضائعة أقل ما يمكن)
المصطلح الإنجليزي : Nesting in Sheets
ولكم جزيل الشكر[/b]

ولتبسيط الأمور دعونا نعمل عل مثال محدد
المستطيل الكبير قياسه ( 1220 , 2440 )
المستطيلات الصغيرة
(341, 680) عدد 2
(752, 262) عدد 1
(376, 597) عدد 2
(446, 865) عدد 2
(396, 865) عدد 1
(336, 865) عدد 4
(335, 1245) عدد 1
(334, 765) عدد 1
(306, 765) عدد 2
(308, 765) عدد 2
(425, 188 )عدد 4
(400, 1000) عدد 1
(333, 1252) عدد 1
(283, 1252) عدد 1
(300, 300) عدد 4
مجموع مساحات المستطيلات الصغيرة 6.64 متر مربع على فرض أن القياسات بالميليمتر
مساحة المستطيل الكبير 2.98 متر مربع
نقسم مجموع مساحات المستطيلات الصغيرة على مساحة المستطيل الكبير 6.64 /2.98 = 2.2
أي يلزمنا 3 مستطيلات كبيرة لترتيب المستطيلات الصغيرة فيها ويكون الثالث غير مكتمل ( أي يحوي ما تبقى من المستطيلات الصغيرة)
من هنا نبدأ الكود لترتيبها

2

النسبة للمثال السابق فيمايلي كود لرسمه ويبقى كود الترتيب (sub NestingRects ) فارغاً ينتظر أحد لكتابته أرجو نسخ الكود وتجربته بمحرر الماكرو
[LEFT]Dim pnt(7) As Double
Dim BigRect(2) As AcadLWPolyline
Dim SmallRect(2 ) As AcadLWPolyline
Dim D As Double
Dim WH(14, 1) As Double
Dim n(14) As Integer
Dim i As Integer
Dim m As Integer
Dim k As Integer
Dim pt1(2) As Double
[B] Dim pt2(2) As Double

[/b]Sub DrawRects()

pnt(0) = D: pnt(1) = 0
pnt(2) = D: pnt(3) = 2440
pnt(4) = D + 1220: pnt(5) = 2440
pnt(6) = D + 1220: pnt(7) = 0
Set BigRect(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(pnt)
BigRect(0).Closed = True
BigRect(0).color = acRed
D = pnt(6) + 50
’
Set BigRect(1) = BigRect(0).Copy
pt2(1) = 2440 + 50
BigRect(1).Move pt1, pt2
Set BigRect(2) = BigRect(1).Copy
BigRect(2).Move pt1, pt2
’
WH(0, 0) = 341: WH(0, 1) = 680: n(0) = 2
WH(1, 0) = 752: WH(1, 1) = 262: n(1) = 1
WH(2, 0) = 376: WH(2, 1) = 597: n(2) = 2
WH(3, 0) = 446: WH(3, 1) = 865: n(3) = 2
WH(4, 0) = 396: WH(4, 1) = 865: n(4) = 1
WH(5, 0) = 336: WH(5, 1) = 865: n(5) = 4
WH(6, 0) = 335: WH(6, 1) = 1245: n(6) = 1
WH(7, 0) = 334: WH(7, 1) = 765: n(7) = 1
WH(8, 0) = 306: WH(8, 1) = 765: n(8 ) = 2
WH(9, 0) = 308: WH(9, 1) = 765: n(9) = 2
WH(10, 0) = 425: WH(10, 1) = 188: n(10) = 4
WH(11, 0) = 400: WH(11, 1) = 1000: n(11) = 1
WH(12, 0) = 333: WH(12, 1) = 1252: n(12) = 1
WH(13, 0) = 283: WH(13, 1) = 1252: n(13) = 1
WH(14, 0) = 300: WH(14, 1) = 300: n(14) = 4

For i = 0 To 14
pnt(0) = D: pnt(1) = 0
pnt(2) = D: pnt(3) = WH(i, 1)
pnt(4) = D + WH(i, 0): pnt(5) = WH(i, 1)
pnt(6) = D + WH(i, 0): pnt(7) = 0
Set SmallRect(m) = ThisDrawing.ModelSpace.AddLightWeightPolyline(pnt)
SmallRect(m).Closed = True
If n(i) > 1 Then
For k = 2 To n(i)
Set SmallRect(m + 1) = SmallRect(m).Copy
pt2(1) = WH(i, 1) + 50
SmallRect(m + 1).Move pt1, pt2
m = m + 1
Next k
End If
m = m + 1
D = pnt(6) + 50
Next i
’
ZoomAll

End Sub

’
Sub NestingRects()

End Sub[/left]