parçaları belirli düzende birleştirmek

Haluk · 22 Temmuz 2022

İkinci durumdaki sorunuzu; sol taraftan tam boy çubukla başlayıp, en sonda artık ne kalırsa ..... diye anlıyorum.

Bu durum için hazırladığım çizim + metraj kodu ve görsel aşağıda verilmiştir;

Parametreler B6, B7 ve B8 hücrelerinden alınmaktadır. Bu hücreler, özel biçimlendirme yapılarak 0,00 cm olarak biçimlendirimiştir.

C#:

Sub Test2()
'   Haluk - 22/07/2022
'   sa4truss@gmail.com

    spanLength = Range("B6")
    lengthMesh = Range("B7")
    Overlap = Range("B8")
  
    For Each xShape In ActiveSheet.Shapes
        If Not Application.Intersect(xShape.TopLeftCell, Range("A2:AA6")) Is Nothing Then
            xShape.Delete
        End If
    Next
  
    Range("E8:E11") = ""
  
'    Olcu cizgisinin baslangici
    dimensionStart = 200

'    Baslangic hasiri
    startX = 200
    endX = startX + 100

    Set ReBar = ActiveSheet.Shapes.AddLine(startX, 40, endX, 40)
    ReBar.Line.Weight = 2

    LabelTop = 20
    LabelLeft = startX + 40

    Set firstMemberLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, LabelLeft, LabelTop, 50, 50)
    firstMemberLabel.TextFrame.Characters.Text = lengthMesh
  
'    Orta hasirlar (tam boy) ve son hasır (degisken boy)
  
    Do
        i = i + 1
        startX = startX + 80
        endX = startX + 100
    
        If i Mod 2 = 0 Then
            startY = 40
            endY = 40
        Else
            startY = 50
            endY = 50
        End If
    
        Set ReBar = ActiveSheet.Shapes.AddLine(startX, startY, endX, endY)
        ReBar.Line.Weight = 2
    
        LabelTop = endY - 20
        LabelLeft = startX + 40
    
        Set memberLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, LabelLeft, LabelTop, 50, 50)
        memberLabel.TextFrame.Characters.Text = lengthMesh
      
'        Bindirme paylarinin belirtilmesi
        If i Mod 2 <> 0 Then
            Set memberLabel1 = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, startX, LabelTop + 20, 50, 50)
            memberLabel1.TextFrame.Characters.Text = Overlap
            memberLabel1.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 176, 240)
          
            Set memberLabel2 = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, startX + 80, LabelTop + 20, 50, 50)
            memberLabel2.TextFrame.Characters.Text = Overlap
            memberLabel2.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 176, 240)
        End If
    Loop While lengthMesh + i * (lengthMesh - Overlap) <= spanLength
      
'    Son cubukta sag taraftaki bindirme payi olcusunu yazmayi iptal et
    If i Mod 2 <> 0 Then
        memberLabel2.TextFrame.Characters.Text = ""
    End If
  
    lengthLastBar = spanLength - i * (lengthMesh - Overlap)
    memberLabel.TextFrame.Characters.Text = lengthLastBar
  
'    Olcu cizgisinin cizimi
    dimensionEnd = endX
  
    Set dimensionLine = ActiveSheet.Shapes.AddLine(dimensionStart, 80, dimensionEnd, 80)
    dimensionLine.Line.Weight = 1
    dimensionLine.Line.ForeColor.RGB = RGB(255, 0, 0)
    dimensionLine.Line.DashStyle = msoLineLongDashDot
    dimensionLine.Line.BeginArrowheadStyle = msoArrowheadTriangle
    dimensionLine.Line.EndArrowheadStyle = msoArrowheadTriangle
  
    Set dimensionLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, (dimensionStart + dimensionEnd) / 2, 60, 80, 80)
    dimensionLabel.TextFrame.Characters.Text = spanLength
    dimensionLabel.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
  
'    Metraj
    Range("E8") = "METRAJ :"
    Range("E9") = i & " Adet L = " & lengthMesh
    Range("E10") = "1 Adet L = " & lengthLastBar
    Range("E11") = "Toplam çubuk boyu = " & i & " X " & lengthMesh & " + 1 X " & lengthLastBar & " = " & i * lengthMesh + lengthLastBar
End Sub

.

modoste · 22 Temmuz 2022

teşekkürler Haluk Hocam

bir deneme ve kontrolde ben yaptım hocam.

modoste · 23 Temmuz 2022

hocam merhaba
ilk 2 durum (sizin çözümlediğiniz) dan farklı olarak bir durum daha söz konusu, parçalar baştan ve sondan tam parça uzunluğunda (500 cm) olmama durumu var
soldaki şekil için 520,457 uzunluk için, tam parçaya gerek olmadan çözüm üretilmiş, sağ taraf için en az 1 tam parça kullanılmış.

iki şekilde de ben sağ taraftaki son parçayı bindirmesiz (250 cm) ekledim bu solda da olabilir elbet. (250 sayısının 500 nin yarısı ile alakası yok hocam rastgele olarak 250 yazdım)

bu durumun çözümü üretilebilir mi.

Haluk · 23 Temmuz 2022

Çözümün algoritmasını hazırlayabilmek için, bilinenler yetersiz.....

Tam çubuk boyu 500 cm ise, hazırlanacak algoritmada sol başlangıçtaki veya sağ bitişteki çubuk boyunun önceden bilinmesi gerekir ki, diğeri hesaplanabilsin.

.

modoste · 23 Temmuz 2022

anladım hocam demek istediğinizi

modoste · 23 Temmuz 2022

son durum için birkaç örnek gönderdim hocam acaba bu kurallar dediğiniz gibi bir algoritma oluşturur mu

Haluk · 23 Temmuz 2022

"L >= 455" zaten 21 No'lu mesajdaki 2. durum diye adlandırdığımız seçenek....

.

modoste · 23 Temmuz 2022

evet hocam dediğiniz doğru ben atlamışım o detayı

modoste · 30 Temmuz 2022

Merhabalar Haluk Hocam Tekrar
4. ve 21. mesajdaki makrolu çözümlerde bulunan çözümlerin formülle bulunması ile ilgili
ekte açıklamaları olan dosyayı gönderiyorum hocam.

Haluk · 30 Temmuz 2022

Formüller ekli dosyadadır;

.

modoste · 30 Temmuz 2022

Teşekkür ederim Haluk Hocam

modoste · 31 Temmuz 2022

Sayın Hocam çok ilginç bir şey saptandı.
aynı mesafe aynı çubuk boyu ve aynı bindirme boyu için farklı 2 çözüm oluyor. bu durumu nasıl açıklayabiliriz,
doğru çözüm resmini eklediğim durumdur.
ekli dosyayı gönderiyorum

Haluk · 31 Temmuz 2022

Bilemiyorum...

.

modoste · 31 Temmuz 2022

bizim yaptığımızda 4 adet 5 metrelik çubuk varken sanki 1 tanesini bindirmeyi de dikkate alıp yarım yarım sağa ve sola ekliyo gibi
makro ile çözüm revize edilir mi hocam

Haluk · 31 Temmuz 2022

Kodu aşağıdaki gibi revize ettim, çizim ve metraj verdiğiniz son örnekteki gibi hesaplanıyor. Başka örneklerde de deneyip, doğruluğunun kanıtlanması gerekir.

C#:

Sub Test3()
'   Haluk - 31/07/2022
'   sa4truss@gmail.com

    spanLength = Range("B6")
    lengthMesh = Range("B7")
    Overlap = Range("B8")
    
    For Each xShape In ActiveSheet.Shapes
        If Not Application.Intersect(xShape.TopLeftCell, Range("A2:AA6")) Is Nothing Then
            xShape.Delete
        End If
    Next
    
    Range("E8:E11") = ""
    
'    Olcu cizgisinin baslangici
    dimensionStart = 200
 
'    Baslangic hasiri
    startX = 200
    endX = startX + 100
 
    Set ReBar = ActiveSheet.Shapes.AddLine(startX, 40, endX, 40)
    ReBar.Line.Weight = 2
 
    LabelTop = 20
    LabelLeft = startX + 40
 
    Set firstMemberLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, LabelLeft, LabelTop, 50, 50)

'    Orta hasirlar (tam boy)
    If (spanLength / lengthMesh - spanLength \ lengthMesh) >= 0.5 Then
        N = spanLength \ lengthMesh
    Else
        N = spanLength \ lengthMesh - 1
    End If
    
    For i = 1 To N
        startX = startX + 80
        endX = startX + 100
      
        If i Mod 2 = 0 Then
            startY = 40
            endY = 40
        Else
            startY = 50
            endY = 50
        End If
      
        Set ReBar = ActiveSheet.Shapes.AddLine(startX, startY, endX, endY)
        ReBar.Line.Weight = 2
      
        LabelTop = endY - 20
        LabelLeft = startX + 40
      
        Set memberLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, LabelLeft, LabelTop, 50, 50)
        memberLabel.TextFrame.Characters.Text = lengthMesh
        
'        Bindirme paylarinin belirtilmesi
        If i Mod 2 <> 0 Then
            Set memberLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, startX, LabelTop + 20, 50, 50)
            memberLabel.TextFrame.Characters.Text = Overlap
            memberLabel.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 176, 240)
            
            Set memberLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, startX + 80, LabelTop + 20, 50, 50)
            memberLabel.TextFrame.Characters.Text = Overlap
            memberLabel.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 176, 240)
        End If
    Next
 
'    Bitis hasiri
    startX = startX + 80
    endX = startX + 100
    
    If (N + 1) Mod 2 = 0 Then
        startY = 40
        endY = 40
    Else
        startY = 50
        endY = 50
    End If
 
    Set ReBar = ActiveSheet.Shapes.AddLine(startX, startY, endX, startY)
    ReBar.Line.Weight = 2
 
    LabelTop = startY - 20
    LabelLeft = startX + 40
      
    Set lastMemberLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, LabelLeft, LabelTop, 50, 50)
    lastMemberLabel.TextFrame.Characters.Text = Round((spanLength - N * (lengthMesh - Overlap * 2) - (N - 1) * Overlap) / 2, 2)
    
    If (N + 1) Mod 2 <> 0 Then
        Set memberLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, startX, LabelTop + 20, 50, 50)
        memberLabel.TextFrame.Characters.Text = Overlap
        memberLabel.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 176, 240)
    End If
    
    firstMemberLabel.TextFrame.Characters.Text = lastMemberLabel.TextFrame.Characters.Text
    
'    Olcu cizgisinin cizimi
    dimensionEnd = endX
    
    Set dimensionLine = ActiveSheet.Shapes.AddLine(dimensionStart, 80, dimensionEnd, 80)
    dimensionLine.Line.Weight = 1
    dimensionLine.Line.ForeColor.RGB = RGB(255, 0, 0)
    dimensionLine.Line.DashStyle = msoLineLongDashDot
    dimensionLine.Line.BeginArrowheadStyle = msoArrowheadTriangle
    dimensionLine.Line.EndArrowheadStyle = msoArrowheadTriangle
    
    Set dimensionLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, (dimensionStart + dimensionEnd) / 2, 60, 80, 80)
    dimensionLabel.TextFrame.Characters.Text = spanLength
    dimensionLabel.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
    
'    Metraj
    Range("E8") = "METRAJ :"
    Range("E9") = N & " Adet L = " & lengthMesh
    Range("E10") = "2 Adet L = " & lastMemberLabel.TextFrame.Characters.Text
    Range("E11") = "Toplam çubuk boyu = " & 2 & " X " & lastMemberLabel.TextFrame.Characters.Text & " + " & N & " X " & lengthMesh & " = " & 2 * lastMemberLabel.TextFrame.Characters.Text + N * lengthMesh
End Sub

.

modoste · 31 Temmuz 2022

sayın hocam en az 15 deneme yaptım ve autocad ile karşılaştırdım ve sonuçlar tam çıkıyo.
Hocam son olarak tam çubuk kaç adet son parça kaç adet ve toplam uzunluğu excel ile formülü yapmıştınız onu yapabilir miyiz.

ilk resimde doğru sonuçlar çıkıyo

2. resimde sonuçlar farklı

gri renkli yerlerdeki formüller daha önce yine burda sorup sizin yazdığınız formüller hocam.

Haluk · 31 Temmuz 2022

B12 hücresine aşağıdaki formülü girin;

Kod:

=IF(B6/B7-INT(B6/B7)>=0,5;INT(B6/B7);INT(B6/B7)-1)

Türkçe Excel için;

IF = EĞER

INT = TAMSAYI

.

modoste · 1 Ağustos 2022

dediğiniz değişikliği yaptım hocam ve sonuç tamam

parçaları belirli düzende birleştirmek

Haluk

Özel Üye

modoste

modoste

Haluk

Özel Üye

modoste

modoste

Haluk

Özel Üye

modoste

modoste

Ekli dosyalar

Haluk

Özel Üye

Ekli dosyalar

modoste

modoste

Ekli dosyalar

Haluk

Özel Üye

modoste

Haluk

Özel Üye

modoste

Haluk

Özel Üye

modoste