parçaları belirli düzende birleştirmek

[modoste]

merhaba sayın hocalarım
ekli tablomda sorumu ilettim

 

[uzmanamele]

Merhaba

İnceleyiniz, formülü sadeleştiriniz.

 

[modoste]

Sayın Uzmanemele hocam çözüm için teşekkürler
şu bilgilerle
tam parça boyu = 500 cm
bindirme boyu = 45 cm
Uzunluk = 1832,10 cm

yazıp makro ile yada formülle yada koşullu biçimle sorumdaki şekiller biçimler sayılar elde edilebilir mi

bu bölüm yani hocam


hocam tünelde çelik hasır profil üzerine bindirme ile uygulandığı için bu tip durumları excel ile çözümü ile ilgili konu

 

[Haluk]

Yukarıdaki çizimlerde bir hata var gibi geldi bana.......

Eğer açıklık 1832,10 cm ise, başlangıç ve bitiş hasırlarının boyu 256,05 cm olması gerekiyor sanki....

Not: Sonradan fark ettim ki; AutoCad çizimi doğru ama, Excel çizimi yanlış.

Benim hazırladığım çizim kodu aşağıdadır...

Sub Test()
'   Haluk - 19/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") = ""

    N = spanLength \ lengthMesh
 
    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)
    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]

benim kırmızı yazdığım yerdeki 45 ler sadece bindirmeleri gösteriyo ama haklısınız orda sadece 256,05 yazmalı
Hocam kodu şöyle güncellesek
A1 hücresine 1832,10
B1 hücresine 500 (çubuk tam boyu)
C1 hücresine 45 (bindirme boyu)
yani makrolar A1,B1 ve C1 verilerinden alsa

 

[Haluk]

Artık, o kadarcık güncellemeyi de bir zahmet siz yaparsınız.....

.

 

[modoste]

Hocam birde en genel haliyle bir makro yapabilir miyiz? şöyle ki
Uzunluk seçilecek mesela 20,46 metre bu mesafe ile ilgili bir detay yok
çubuk boyu 500 cm değilde değişken yani 700 cm olabilir, 400 cm olabilir
bindirme boyu da 45 cm değil, mesela 32 cm olabilir,60 cm olabilir gibi
böyle durumlar için en geniş anlamda çözüm yapılabilir mi

 

[Haluk]

Muhterem biraderim;

Kod zaten genel bir kod olarak hazırlandı. Kodun ilk 3 satırındaki parametreler; Açıklık, Hasır Boyu ve Bindirme Boyu.

Bunları hücrelerden okutursanız, amacınıza ulaşırsınız.

14 yıllık üyesiniz, artık o kadarını yaparsınız.....

*********************************************
Not: Düzenleme 4 No'lu mesajda yapıldı...

.

 

[modoste]

Telefondan tam göremedim hocam yarın sabah dediklerinizi uygulayacağım. Teşekkür ederim tekrardan

 

[modoste]

alternatif mesafeler, uzunluklar denedim makro kodunda ufacık bir değişiklik ekledim ve sonuçlar hatasız çıkıyo.
Teşekkürler tekrardan Haluk Hocam ve uzmanamele Hocam

 

[Haluk]

Valla övünmek gibi olmasın ama, bu kod AutoCad kadar güzel çizim yaptı ...

.

 

[modoste]

Hocam makronun altına şunları yazdırabilir miyiz
benim en son gonderdiğim örneğe göre
5 adet tam çubuk L = 800 cm
2 adet tam olmayan çubuk L= 354,29 cm
Bindirmeler eklenerek toplam kullanılmış çubuk boyu = 4456,58+6*42 = 4708,28 cm

 

[Haluk]

4 No'lu mesajdaki kod, buna göre güncellendi....

.

 

[modoste]

işlem tamam sayın hocam

 

[Haluk]

işlem tamam sayın hocam

Eklediğiniz resme baktığımda, parametreleri hücrelerden almadığınızı gördüm. Ama, herhalde düzeltmişinizdir....

.

 

[modoste]

düzeltildi sayın hocam

 

[Haluk]

4 No'lu mesajdaki kodda bir revizyon yapmıştım, son halini kullanırsanız daha iyi olur....

Parametreler B6, B7 ve B8 hücrelerinden alınıyor.

.

 

[modoste]

sayın hocam ilk durum için çözüm üretildi.
şimdi 2. durum için bir örnekleme gönderdim

 

[uzmanamele]

Merhaba
Hasır çelik standart boyutlarına göre yapmaya çalıştığınız yerleşim yanlış.
Her iki dosyanızdaki ölçüleri pratikte uygulanabilecek şekle getirmeniz gerekir.
346,05 cm ölçü olmaz. 520,457 cm ölçü hiç olmaz.

215x500 Hasır çeliği pratikte, boyda 45 cm bindirme yapamazsınız.
Tabaka ölçülerini incelerseniz ne demek istediğimi anlarsınız.
Tabaka yerleşim boyutlarını sadeleştirirseniz çözüm daha kolay olur.

 

[modoste]

şekildeki gibi durumları excel ile çözebilme adına (bindirme boylarını vs bu ölçüleri de (45 cm gibi), değiştirilebilir çözümler 35 cm olması gibi) durumlardaki matematiksel çözümleri merak etmiştim, nasıl formüllenir, makro ile çözülür diye, teknik olarak haklı olduğunuz yerler var elbet ama bu sorumu kibrit çöplerini belirli bir bindirme payı vererek bir aralığı nasıl çevreleriz gibi sorunun çözümü için genelleyelim.
ilk makrolu (mükemmel çözümde) sol ve sağdan eşit uzunlukta parça ile çözüm ve şekilden sağ ve soldan taşma olmayacaktı.
şimdiki sorum ise bir kenarı sabit bırakıp (kenardan taşmayıp) diğer kenardan 1 adet bindirme taşması durumunda parçaların kaç adet ve nasıl boyutlanması