• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

parçaları belirli düzende birleştirmek

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
237785
bu bölüm yani hocam

237786
hocam tünelde çelik hasır profil üzerine bindirme ile uygulandığı için bu tip durumları excel ile çözümü ile ilgili konu
 
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...



C#: 
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


Capture.PNG

.
 
Son düzenleme:
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
 
Artık, o kadarcık güncellemeyi de bir zahmet siz yaparsınız.....

.
 
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
 
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ı...

.
 
Son düzenleme:
Telefondan tam göremedim hocam yarın sabah dediklerinizi uygulayacağım. Teşekkür ederim tekrardan
 
237815
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
 
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
 
4 No'lu mesajdaki kod, buna göre güncellendi....

.
 
237819
işlem tamam sayın hocam
 
237865
düzeltildi sayın hocam
 
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.

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

Ekli dosyalar

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.
 
237872
ş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ı
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst