Как в AutoCad проложить кабели в лотках пучками
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > .NET > Как в AutoCad проложить кабели в лотках пучками

Как в AutoCad проложить кабели в лотках пучками

Ответ
Поиск в этой теме
Непрочитано 19.08.2024, 10:18 #1
Как в AutoCad проложить кабели в лотках пучками
Stud2024
 
Регистрация: 19.08.2024
Сообщений: 6

Доброго времени суток!
Работаю над программой по прокладке кабелей в лотках пучками
Моя программа строит в прямоугольник(лоток) заданного размера . Лоток заполняется окружностями(диаметрами кабеля) находящимися в буфере обмена. У меня получается построение рядами.
Подскажите как и какие функции использовать что бы кабели лотка заполнялись способом прокладки кабелей пучками ?
Нашел подобное. Как в этом алгоритм встроить возможность задания размеров лотка ? И не пойму откуда берутся диаметры кабелей

Код:
[Выделить все]
 Attribute VB_Name = "Trunk"
Option Private Module
Option Explicit

Public Type point
    x As Double
    y As Double
End Type

Public Type Ncircus
    r As Double
    n As Integer
End Type

Public Type circus
    r As Double
    x As Double
    y As Double
End Type


Private Const CalcMode = 1

Const MaxValue = 1E+99
Public Const Pi = 3.14159265358979

Public Sub DecodeCircus(ByRef inarr() As Ncircus, ByRef NIn As Integer, ByRef outarr() As circus, ByRef nOut As Integer)
    Dim i, j

    nOut = 0
    For i = NIn - 1 To 0 Step -1
        For j = 0 To inarr(i).n - 1
            outarr(nOut).r = inarr(i).r
            nOut = nOut + 1
        Next
    Next
End Sub

Public Sub CalcTrunk(ByRef PStart As point, ByRef PEnd As point, ByRef Arr() As circus, ByRef n As Integer)
    Dim i As Integer
    Dim h As Double
    Dim H2 As Double
    Dim xx As circus
    Dim j
    Dim key As Boolean
    Dim Brr(1) As circus
    Dim m
    Dim offsetx
    Dim offsety
    Dim dx
    Dim dy
    
    Select Case CalcMode
    Case 1
    
        Arr(0).x = PStart.x + Arr(0).r
        Arr(0).y = PStart.y + Arr(0).r
    
        For i = 1 To n - 1
            Arr(i).y = MaxValue
            Arr(i).x = 0
            
            xx = TryLeft(Arr, i, PStart, PEnd)
            If xx.y < Arr(i).y Then
                Arr(i) = xx
            End If
            xx = TryBottom(Arr, i, PStart, PEnd)
            If xx.y < Arr(i).y Then
                Arr(i) = xx
            End If
            xx = TryRight(Arr, i, PStart, PEnd)
            If xx.y < Arr(i).y Then
                Arr(i) = xx
            End If
            xx = TryPair(Arr, i, PStart, PEnd)
            If xx.y < Arr(i).y Then
                Arr(i) = xx
            End If
        Next
    Case 2
        i = 0
        Do
            key = False
            If i + 6 < n Then
                key = True
                For j = i To i + 6
                    If Arr(j).r <> Arr(i).r Then key = False
                Next
                If key Then
                    Arr(i).r = Arr(i).r * 3
                End If
            End If
            If i = 0 Then
                Arr(0).x = PStart.x + Arr(0).r
                Arr(0).y = PStart.y + Arr(0).r
            Else
                Arr(i).y = MaxValue
                Arr(i).x = 0
                
                xx = TryLeft(Arr, i, PStart, PEnd)
                If xx.y < Arr(i).y Then
                    Arr(i) = xx
                End If
                xx = TryBottom(Arr, i, PStart, PEnd)
                If xx.y < Arr(i).y Then
                    Arr(i) = xx
                End If
                xx = TryRight(Arr, i, PStart, PEnd)
                If xx.y < Arr(i).y Then
                    Arr(i) = xx
                End If
                xx = TryPair(Arr, i, PStart, PEnd)
                If xx.y < Arr(i).y Then
                    Arr(i) = xx
                End If
            End If
            Debug.Print Arr(i).x, Arr(i).y, Arr(i).r
            
            If key Then
                Arr(i).r = Arr(i).r
                
                Arr(i + 1).x = Arr(i).x
                Arr(i + 1).y = Arr(i).y - Arr(i + 1).r * 2
                
                Arr(i + 2).x = Arr(i).x
                Arr(i + 2).y = Arr(i).y + Arr(i + 1).r * 2
            
                Arr(i + 3).x = Arr(i).x - 0.866 * Arr(i + 1).r * 2
                Arr(i + 3).y = Arr(i).y - 0.5 * Arr(i + 1).r * 2
                
                Arr(i + 4).x = Arr(i).x + 0.866 * Arr(i + 1).r * 2
                Arr(i + 4).y = Arr(i).y - 0.5 * Arr(i + 1).r * 2
                
                Arr(i + 5).x = Arr(i).x - 0.866 * Arr(i + 1).r * 2
                Arr(i + 5).y = Arr(i).y + 0.5 * Arr(i + 1).r * 2
                
                Arr(i + 6).x = Arr(i).x + 0.866 * Arr(i + 1).r * 2
                Arr(i + 6).y = Arr(i).y + 0.5 * Arr(i + 1).r * 2
                i = i + 7
            Else
                i = i + 1
            End If
        Loop While i < n
    Case Else
   
        i = 1
        j = 2
        m = 29
        offsety = Arr(0).r
        offsetx = Arr(0).r
        Arr(0).x = PStart.x + offsetx
        Arr(0).y = PStart.y + Arr(0).r
        Do
            Do
                If Arr(i).r = Arr(i - 1).r Then
                    Select Case j
                    Case 2, 4, 7, 11, 16, 22, 29, 37, 46, 56, 67, m
                        offsety = Arr(i).r
                        offsetx = offsetx + Arr(i).r * 2
                        dx = 0
                        dy = 0
                    Case Else
                        dx = dx - Arr(i).r
                        dy = dy + Arr(i).r * 0.866 * 2
                    End Select
                    If PStart.x + offsetx + dx + Arr(i).r > PEnd.x Or _
                        PStart.y + offsety + dy + Arr(i).r > PEnd.y Then Exit Do
                    Arr(i).x = PStart.x + offsetx + dx
                    Arr(i).y = PStart.y + offsety + dy
                Else
                    Exit Do
                End If
                i = i + 1
                j = j + 1
            Loop While i < n
            offsetx = offsetx + Arr(i).r + Arr(i - 1).r
            If PStart.x + offsetx + dx + Arr(i).r > PEnd.x Or _
                PStart.y + offsety + dy + Arr(i).r > PEnd.y Then Exit Do
            Arr(i).x = PStart.x + offsetx
            Arr(i).y = PStart.y + Arr(i).r
            j = 2
            i = i + 1
        Loop While i < n
    
        While i < n
            Arr(i).y = MaxValue
            Arr(i).x = 0
            
            xx = TryLeft(Arr, i, PStart, PEnd)
            If xx.y < Arr(i).y Then
                Arr(i) = xx
            End If
            xx = TryBottom(Arr, i, PStart, PEnd)
            If xx.y < Arr(i).y Then
                Arr(i) = xx
            End If
            xx = TryRight(Arr, i, PStart, PEnd)
            If xx.y < Arr(i).y Then
                Arr(i) = xx
            End If
            xx = TryPair(Arr, i, PStart, PEnd)
            If xx.y < Arr(i).y Then
                Arr(i) = xx
            End If
            i = i + 1
        Wend
    
    
    End Select
End Sub

Private Function NoCollision(ByRef t As circus, ByRef Arr() As circus, ByVal n As Integer, ByRef PStart As point, ByRef PEnd As point) As Boolean
    Dim i
    Dim a, b, c As Double
    
    NoCollision = True
    
    If t.x - t.r < PStart.x Then NoCollision = False: Exit Function
    If t.x + t.r > PEnd.x Then NoCollision = False: Exit Function
    If t.y - t.r < PStart.y Then NoCollision = False: Exit Function
    For i = 0 To n
        a = Arr(i).x - t.x
        b = Arr(i).y - t.y
        c = Arr(i).r + t.r
        If Round(a * a + b * b, 3) < Round(c * c, 3) Then
            NoCollision = False
            Exit Function
        End If
    Next
End Function

Private Function TryBottom(ByRef Arr() As circus, ByVal n As Integer, ByRef PStart As point, ByRef PEnd As point) As circus
    Dim i As Integer
    Dim Temp As circus
    
    TryBottom = Arr(n)
    TryBottom.y = MaxValue
    Temp = Arr(n)
    
    For i = 0 To n - 1
        If Abs(Arr(i).y - PStart.y - Arr(i).r) <= Abs(2 * Arr(n).r) Then
            Temp.x = Arr(i).x + Sqr((Arr(n).r + Arr(i).r) * (Arr(n).r + Arr(i).r) - (Arr(n).r - Arr(i).r) * (Arr(n).r - Arr(i).r))
            Temp.y = PStart.y + Temp.r
            If NoCollision(Temp, Arr, n - 1, PStart, PEnd) Then
                TryBottom = Temp
            End If
        End If
    Next
End Function

Private Function TryPair(ByRef Arr() As circus, n As Integer, ByRef PStart As point, ByRef PEnd As point) As circus
    Dim i, j As Integer
    Dim Temp As circus
    Dim a, b, c, D, e As Double
    Dim alpha, beta As Double
    Dim ls As circus
    Dim rs As circus
    
    TryPair = Arr(n)
    TryPair.y = MaxValue
    Temp = Arr(n)

    For i = 1 To n - 1
        For j = 0 To i - 1
            If Arr(i).x < Arr(j).x Then
                ls = Arr(i)
                rs = Arr(j)
            Else
                ls = Arr(j)
                rs = Arr(i)
            End If
            
            If Abs(rs.x - ls.x) <= 2 * Arr(n).r + rs.r + ls.r Then
                If Abs(rs.y - ls.y) <= 2 * Arr(n).r + rs.r + ls.r Then
                    b = Sqr((rs.x - ls.x) * (rs.x - ls.x) + (rs.y - ls.y) * (rs.y - ls.y))
                    If b <= 2 * Arr(n).r + rs.r + ls.r Then
                        a = rs.r + Arr(n).r
                        c = Arr(n).r + ls.r
                        alpha = Acos((b * b + c * c - a * a) / 2 / b / c)
                        D = rs.y - ls.y
                        e = rs.x - ls.x
                        If e = 0 Then
                            beta = 0
                        Else
                            beta = Atn(D / e)
                        End If
                        Temp.x = ls.x + c * Cos(alpha + beta)
                        Temp.y = ls.y + c * Sin(alpha + beta)
                        If NoCollision(Temp, Arr, n - 1, PStart, PEnd) Then
                            If Temp.y < TryPair.y Then
                                TryPair = Temp
                            End If
                        End If
                    End If
                End If
            End If
        Next
    Next
End Function

Private Function TryLeft(ByRef Arr() As circus, ByVal n As Integer, ByRef PStart As point, ByRef PEnd As point) As circus
    Dim i As Integer
    Dim Temp As circus
    Dim a As Double
    
    TryLeft = Arr(n)
    TryLeft.y = MaxValue
    Temp = Arr(n)
    
    For i = 0 To n - 1
        a = Abs(Arr(i).x - PStart.x - Arr(n).r)
        If (Arr(i).x - PStart.x - Arr(i).r) <= 2 * Arr(n).r Then
            Temp.x = PStart.x + Temp.r
            Temp.y = Arr(i).y + Sqr((Arr(n).r + Arr(i).r) * (Arr(n).r + Arr(i).r) - a * a)
            If NoCollision(Temp, Arr, n - 1, PStart, PEnd) Then
                TryLeft = Temp
            End If
        End If
    Next
End Function

Private Function TryRight(ByRef Arr() As circus, ByVal n As Integer, ByRef PStart As point, ByRef PEnd As point) As circus
    Dim i As Integer
    Dim Temp As circus
    Dim a As Double
    
    TryRight = Arr(n)
    TryRight.y = MaxValue
    Temp = Arr(n)
    
    For i = 0 To n - 1
        a = Abs(PEnd.x - Arr(i).x - Arr(n).r)
        If PEnd.x - Arr(i).x - Arr(i).r <= 2 * Arr(n).r Then
            Temp.x = PEnd.x - Temp.r
            Temp.y = Arr(i).y + Sqr((Arr(n).r + Arr(i).r) * (Arr(n).r + Arr(i).r) - a * a)
            If NoCollision(Temp, Arr, n - 1, PStart, PEnd) Then
                TryRight = Temp
            End If
        End If
    Next
End Function

Private Function Acos(ByVal a As Double) As Double
    a = Round(a, 5)
    If a = 1 Then
        Acos = 0
    ElseIf a = -1 Then
        Acos = Pi
    Else
        Acos = Atn(-a / Sqr(-a * a + 1)) + 2 * Atn(1)
    End If
End Function

Public Sub DrawCables(ByRef blk As AcadBlockReference, ByRef Arr() As circus, ByRef n As Integer, ByRef doc As AecbDocument)
    Dim i As Integer
    Dim pnt(3) As Double
    Dim pnt2 As Variant
    Dim dblscale As Double

    dblscale = blk.XEffectiveScaleFactor
    pnt2 = blk.InsertionPoint
    For i = 0 To n - 1
        pnt(0) = (Arr(i).x - pnt2(0) + 0.7) * dblscale + pnt2(0)
        pnt(1) = (Arr(i).y - pnt2(1) + 0.7) * dblscale + pnt2(1)
        Call DrawCirc(pnt, Arr(i).r * dblscale, doc)
    Next
End Sub

Private Sub DrawCirc(ByRef pnt() As Double, D As Double, ByRef doc As AecbDocument)
    Dim xi(0 To 2) As Double
    Dim objTemp As AcadObject
    xi(0) = pnt(0): xi(1) = pnt(1): xi(2) = 0#
    Set objTemp = doc.ModelSpace.AddCircle(xi, (D))
End Sub

Миниатюры
Нажмите на изображение для увеличения
Название: Кабельная лестница.PNG
Просмотров: 120
Размер:	36.3 Кб
ID:	264301  Нажмите на изображение для увеличения
Название: Пример прокладки.jpg
Просмотров: 115
Размер:	25.0 Кб
ID:	264302  


Последний раз редактировалось Stud2024, 19.08.2024 в 12:45.
Просмотров: 1474
 
Непрочитано 19.08.2024, 13:07
#2
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,499


Цитата:
Сообщение от Stud2024 Посмотреть сообщение
Подскажите как и какие функции использовать что бы кабели лотка заполнялись способом прокладки кабелей пучками ?
а откуда акад может знать про наши нормы раскладки кабелей, чтобы в нем (акаде) неожиданно появились какие-то заточенные под это функции?) Есть условный критерий в 40% для качественной оценки - могут ли вообще теоретически кабели "втиснуться" в лоток выбранного размера. Но это достаточно условно все - зависит от диаметров кабелей, насколько они упругие, раскатывали ли кабели заранее до начала монтажа и т.д. Если сумеете алгоритмизировать это всё - сам код написать уже не составит труда)
Сергей812 вне форума  
 
Автор темы   Непрочитано 19.08.2024, 13:24
#3
Stud2024


 
Регистрация: 19.08.2024
Сообщений: 6


Здравствуйте!
У меня есть плагин который рядами кабели раскладывает. Пример работы (скриншот) во вложении. Построен по диаметрам из буфера(2 3 4 5 2 2 6 3 2 3 4 5 2 2 6 3 2 3 4 5 2 2 6 3)

Как пучками прокладывать я не понимаю
Миниатюры
Нажмите на изображение для увеличения
Название: изображение_2024-08-19_132156167.png
Просмотров: 81
Размер:	33.4 Кб
ID:	264307  

Последний раз редактировалось Stud2024, 19.08.2024 в 14:26.
Stud2024 вне форума  
 
Непрочитано 19.08.2024, 15:04
#4
v.psk

конструктор
 
Регистрация: 14.08.2014
Псков
Сообщений: 7,295


на бумаге то может и можно так затолкать, а по факту....да и по прямой емнип запрещено прокладывать, кабель должен быть уложен змейкой
v.psk вне форума  
 
Непрочитано 19.08.2024, 15:11
#5
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,499


Цитата:
Сообщение от v.psk Посмотреть сообщение
, кабель должен быть уложен змейкой
в лотках?
Сергей812 вне форума  
 
Непрочитано 19.08.2024, 15:26
#6
v.psk

конструктор
 
Регистрация: 14.08.2014
Псков
Сообщений: 7,295


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
в лотках?
ну хорошо, не уверен))
я и в трубе и в лотках ... нигде не вытягиваю кабель струной
v.psk вне форума  
 
Непрочитано 19.08.2024, 17:40
#7
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,499


Цитата:
Сообщение от v.psk Посмотреть сообщение
нигде не вытягиваю кабель струной
хотя по крошечным официальным запасам на монтаж.. Эти запасы с тех времен, когда на объекте кабелей было в разы меньше и было время их прокладывать аккуратно - если было желание, конечно..) А змейкой в грунте укладывается - чтобы неизбежные подвижки грунта тащили кабель, а не рвали.
Сергей812 вне форума  
 
Непрочитано 19.08.2024, 21:06
#8
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,377


Offtop:
Цитата:
Сообщение от Сергей812 Посмотреть сообщение
А змейкой в грунте укладывается - чтобы неизбежные подвижки грунта тащили кабель, а не рвали.
А не компенсация температурных воздействий?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 19.08.2024, 21:36
#9
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,499


Offtop:
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А не компенсация температурных воздействий?
И это тоже
Цитата:
ПУЭ "кабели должны быть уложены с запасом по длине, достаточным для компенсации возможных смещений почвы и температурных деформаций самих кабелей и конструкций, по которым они проложены; укладывать запас кабеля в виде колец (витков) запрещается;"
Сергей812 вне форума  
 
Непрочитано 20.08.2024, 00:15
#10
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,499


а насчет темы: пучки кабелей собираются по функциональному назначению все-таки, поэтому как собираетесь их автоматически раскидывать по пучкам? А в целом - ищите алгоритмы упаковки окружностей (кругов). Сам акад тут не причем совершенно)
Сергей812 вне форума  
 
Автор темы   Непрочитано 20.08.2024, 09:11
#11
Stud2024


 
Регистрация: 19.08.2024
Сообщений: 6


Да автоматически раскидывать по пучкам точнее по индексам( Е Т)
Stud2024 вне форума  
 
Автор темы   Непрочитано 20.08.2024, 13:29
#12
Stud2024


 
Регистрация: 19.08.2024
Сообщений: 6


Нашел нечто подобное, заполняет листы. Не могу запустить

Код:
[Выделить все]
 using System;
using System.Collections.Generic;
using System.Linq;

public class Sheet
{
    public double W { get; set; }
    public double H { get; set; }
    public List<Circle> Circles { get; set; }

    public Sheet(double w, double h)
    {
        W = w;
        H = h;
        Circles = new List<Circle>();
    }
}

public class Circle
{
    public double? Cx { get; set; }
    public double? Cy { get; set; }
    public double R { get; set; }

    public Circle(double r, double? cx = null, double? cy = null)
    {
        Cx = cx;
        Cy = cy;
        R = r;
    }

    public static bool TwoCircleIntersections(Circle c1, Circle c2)
    {
        double x0 = c1.Cx.Value, y0 = c1.Cy.Value, r0 = c1.R;
        double x1 = c2.Cx.Value, y1 = c2.Cy.Value, r1 = c2.R;
        double d = Math.Sqrt(Math.Pow(x1 - x0, 2) + Math.Pow(y1 - y0, 2));
        if (d > r0 + r1) return false;
        if (d < Math.Abs(r0 - r1)) return false;
        if (d == 0 && r0 == r1) return false;
        return true;
    }
}

public class CirclePacking
{
    public double SheetW { get; set; }
    public double SheetH { get; set; }
    public Dictionary<double, int> UserCircles { get; set; }
    public List<Circle> Circles { get; set; }
    public List<Sheet> Sheets { get; set; }
    public Dictionary<double, int> CirclesExcluded { get; set; }
    public double WeldingW { get; set; }

    public CirclePacking(double sheetW, double sheetH, Dictionary<double, int> userCircles, double weldingW)
    {
        SheetW = sheetW;
        SheetH = sheetH;
        UserCircles = userCircles;
        Circles = new List<Circle>();
        Sheets = new List<Sheet>();
        CirclesExcluded = new Dictionary<double, int>();
        WeldingW = weldingW;
    }

    public void CreateCirclesSorted()
    {
        Circles.Clear();
        foreach (var i in UserCircles.Keys.OrderByDescending(x => x))
        {
            for (int k = 0; k < UserCircles[i]; k++)
            {
                Circles.Add(new Circle(i));
            }
        }
    }

    public void CleanCircles()
    {
        List<Circle> circlesCleaned = new List<Circle>();
        foreach (var i in UserCircles.Keys)
        {
            for (int k = 0; k < UserCircles[i]; k++)
            {
                circlesCleaned.Add(new Circle(i));
            }
        }
        Circles = circlesCleaned;
    }

    public void PackingV2()
    {
        CreateCirclesSorted();
        while (UserCircles.Values.Sum() > 0)
        {
            Sheets.Add(new Sheet(SheetW, SheetH));
            Sheet currentSheet = Sheets[^1];
            foreach (var i in Circles)
            {
                (i.Cx, i.Cy) = FindBestPackingStartPoint(currentSheet, i);
                if (i.Cx == null && i.Cy == null)
                {
                    if (!CirclesExcluded.ContainsKey(i.R))
                    {
                        CirclesExcluded[i.R] = 1;
                    }
                    else
                    {
                        CirclesExcluded[i.R]++;
                    }
                    UserCircles[i.R]--;
                }
                else
                {
                    if (i.Cx > currentSheet.W - i.R - WeldingW)
                    {
                        // Do nothing
                    }
                    else
                    {
                        UserCircles[i.R]--;
                        currentSheet.Circles.Add(i);
                    }
                }
            }
            CleanCircles();
        }
    }

    public void Packing()
    {
        CreateCirclesSorted();
        Sheets.Add(new Sheet(SheetW, SheetH));
        Sheet currentSheet = Sheets[0];

        foreach (var i in Circles)
        {
            (i.Cx, i.Cy) = FindBestPackingStartPoint(currentSheet, i);

            if (i.Cx == null && i.Cy == null)
            {
                if (!CirclesExcluded.ContainsKey(i.R))
                {
                    CirclesExcluded[i.R] = 1;
                }
                else
                {
                    CirclesExcluded[i.R]++;
                }
            }
            else
            {
                if (i.Cx > currentSheet.W - i.R - WeldingW)
                {
                    Console.WriteLine("Adding next sheet");
                    Sheets.Add(new Sheet(SheetW, SheetH));
                    currentSheet = Sheets[^1];
                    (i.Cx, i.Cy) = FindBestPackingStartPoint(currentSheet, i);
                }
                UserCircles[i.R]--;
                currentSheet.Circles.Add(i);
            }
        }
    }

    public (double?, double?) FindBestPackingStartPoint(Sheet s, Circle c)
    {
        // Implementation of the method to find the best packing start point
        // This part of the code is incomplete in the original Python code
        // You will need to implement the logic here
        return (null, null);
    }
}

Stud2024 вне форума  
 
Непрочитано 24.08.2024, 17:50
#13
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,499


т.е. это вас вообще не смутило
Цитата:
// Implementation of the method to find the best packing start point
// This part of the code is incomplete in the original Python code
// You will need to implement the logic here
т.е. надо самим реализовывать логику, что это не полный вариант кода.
===
Вот, кстати, исходный код на питоне с кратким описанием алгоритма. А тут код по упаковке в окружность.

Последний раз редактировалось Сергей812, 25.08.2024 в 14:02. Причина: добавлена ссылка
Сергей812 вне форума  
 
Автор темы   Непрочитано 25.08.2024, 21:32
#14
Stud2024


 
Регистрация: 19.08.2024
Сообщений: 6


Только в этом коде рандом количества окружностей. Как сделать что бы можно было из буфера обмена окружности брать с разными диаметрами и заполнять?)
https://through-the-interface.typepa...using-net.html
Stud2024 вне форума  
 
Автор темы   Непрочитано 17.09.2024, 16:00
#15
Stud2024


 
Регистрация: 19.08.2024
Сообщений: 6


Нашел алгоритм. Не совсем работает

Код:
[Выделить все]
 Private Sub Form_Load()
 
Dim n As Integer
Dim r As Double
Dim r1 As Double
 
  'n = 3   '(currently set in loop below)
  r = 2000
 
Dim centre_X As Double
Dim centre_Y As Double
   centre_X = r
   centre_Y = r
   Me.Show
   
 
Const pi = 3.14159265358979         '180°
Const pi2 = 3.14159265358979 * 2    '360°
Const pi_d2 = 3.14159265358979 / 2  ' 90°
Dim radians_per_circle As Double
Dim ang As Double
Dim i As Long
Dim s As Double
   
  For n = 1 To 20
    Me.Cls          'draw outer circle
    Me.Circle (centre_X, centre_Y), r, vbBlack
 
                  'find radians (of outer circle) per inner circle
    radians_per_circle = pi2 / n
 
                  'find radius of inner circle
    s = Sin(radians_per_circle / 2)
    r1 = (r * s) / (s + 1)
   
    For i = 0 To n
      ang = (radians_per_circle * i) - pi_d2
  
      Circle (centre_X + (Cos(ang) * (r - r1)), _
              centre_Y + (Sin(ang) * (r - r1))), _
              r1, _
              vbRed
    Next i
 
    MsgBox n
  Next n
 
End Sub
Миниатюры
Нажмите на изображение для увеличения
Название: tel.gif
Просмотров: 20
Размер:	12.1 Кб
ID:	264740  
Stud2024 вне форума  
 
Непрочитано 16.12.2024, 09:22
#16
posetitel


 
Регистрация: 16.10.2013
Сообщений: 394


Перед реализацией в коде нужно понять логику раскладки по пучкам. Может умные мужи местного форума подскажут сию логику, тоже буду признателен.
Исходные данные: есть n-ное количество кабелей Ni-ого диаметра, давайте для наглядности ограничимся пятью кабелями (1кабель - диаметр 10мм, 2кабель - диаметр 20мм, 3кабель - диаметр 30мм, 4кабель - диаметр 15мм, 5кабель - диаметр 25мм). Для визуализации прилагаю картинку, см. верхний чертеж (кабели уложены не вплотную, а в условную ячейку со стороной квадрата равной диаметру кабеля, это видно по просвету у кабеля 3 и 4, т.е. теоретически можно было бы их чуть-чуть уплотнить, но это уже мелочи)
Самое простое, что напрашивается - это отсортировать кабели по уменьшению диаметра и прокладывать рядами. См. прилагаемую картинку нижний чертеж. Кабели опять уложены не вплотную друг к другу, а в условную ячейку со стороной квадрата, равной диаметру кабеля. Если принять лоток размером 70х70, то остаются пустые места, т.е. заполняемость оставляет желать лучшего. Можно было бы кабель 1 уложить рядом с пятым в первый ряд.
Теоретически, конечно, можно оставить эту неполную заполняемость с допущениями, что по факту и диаметры кабелей будут не строго соответствовать заявленным в паспорте, и на выше обсуждаемую змейку запас, и на радиусы изгиба кабеля в ответвлениях трасс и т.д. и т.п. Для практической реализации такой алгоритм скорее всего будет оптимальным.
Но если заморочиться с точным алгоритмом раскладки, то какие идеи будут?
PS. глянул выше приведенные алгоритмы, в раскладке окружностей по листам подход примерно как у меня, в нем тоже кабели маленького диаметра остаются в конце, а их можно было бы уложить между большими кабелями. Алгоритмы распределения окружностей по кругу для меня пока непонятен, но и там распределение по кругу, а не по прямоугольнику (лотку)
Миниатюры
Нажмите на изображение для увеличения
Название: На форум.png
Просмотров: 23
Размер:	44.1 Кб
ID:	265930  

Последний раз редактировалось posetitel, 16.12.2024 в 09:32.
posetitel вне форума  
 
Непрочитано 16.12.2024, 13:40
#17
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,499


Цитата:
Сообщение от posetitel Посмотреть сообщение
в нем тоже кабели маленького диаметра остаются в конце, а их можно было бы уложить между большими кабелями.
монтажники скажут вам большое спасибо за "упаковку") а так выше же написано
Цитата:
Сообщение от Сергей812 Посмотреть сообщение
ищите алгоритмы упаковки окружностей (кругов).
Сергей812 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > .NET > Как в AutoCad проложить кабели в лотках пучками



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Плагин создания кабельных линий и генерации КЖ раздела КИПиА. Протестировано на AutoCAD 2015...2022 и офис 2013...2019. NanoCAD 23 petro_f Готовые программы 244 26.09.2024 10:25
Видеоуроки AutoCAD kosmax AutoCAD 173 17.02.2017 15:08
AutoCAD 2008, Функция "Последние Файлы" никак не хочет работать Fredyk AutoCAD 4 05.07.2012 08:35
Стандарт использования AutoCAD в приборостроении (советы и обсуждение) Immortal_6666 AutoCAD 9 06.06.2012 10:11
В русской версии AutoCAD 2010 SP1 32-bit файл Acad.PGP содержит ошибки. hwd Баги и пожелания в Autodesk 21 21.04.2010 20:27