EXCEL VBA İLE GEOMETRİK DESEN ÇİZİLEBİLİR Mİ

unalmetin · Perşembe saat 15:31'de

Arkadaşlar herkese merhaba, bir sorum olacak .excel vba ile geometrik desenler çizdirebilir miyiz. selçuklu yıldızı desenine benzeyen desenler çizilebilir mi. Desen çapı, kol genişliği vs. ölçüleri bizden isteyecek ve deseni çizebilecek. Bilen arkadaşlar cevap verirlerse çok sevinirim. Şimdiden ilginize teşekkür ederim.

muhasebeciyiz · Perşembe saat 17:02'de

Kod:

Sub DrawSelcukluStar()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)
    
    Dim diameter As Double
    Dim armWidth As Double
    Dim centerX As Double
    Dim centerY As Double
  
    diameter = Application.InputBox("Desenin çapını girin:", Type:=1)
    armWidth = Application.InputBox("Kol genişliğini girin:", Type:=1)
    
    centerX = ws.Cells(1, 1).Width + diameter / 2
    centerY = ws.Cells(1, 1).Height + diameter / 2
  
    ws.Shapes.SelectAll
    Selection.Delete
  
    Dim i As Integer
    Dim angle As Double
    Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    Dim outerRadius As Double, innerRadius As Double
    
    outerRadius = diameter / 2
    innerRadius = (outerRadius - armWidth) / 2
    
    For i = 0 To 7
        angle = i * 45 * WorksheetFunction.Pi / 180
        x1 = centerX + outerRadius * Cos(angle)
        y1 = centerY - outerRadius * Sin(angle)
        x2 = centerX + innerRadius * Cos(angle + 22.5 * WorksheetFunction.Pi / 180)
        y2 = centerY - innerRadius * Sin(angle + 22.5 * WorksheetFunction.Pi / 180)
      
        ws.Shapes.AddLine centerX, centerY, x1, y1
        ws.Shapes.AddLine x1, y1, x2, y2
    Next i
  
    ws.Shapes.AddShape msoShapeOval, centerX - innerRadius, centerY - innerRadius, 2 * innerRadius, 2 * innerRadius
    
End Sub

Bu kod, Selçuklu yıldızının sekiz köşesini çizer. Kullanıcıdan alınan çap ve kol genişliği bilgileri ile deseni çizer. VBA kodu temel geometrik hesaplamalar kullanarak her bir kolun başlangıç ve bitiş noktalarını belirler ve ardından bunları çizer.

İlk değer 250 yazdım sonraki değer 75 yazdım deseni çizdi.Denermisiniz

Muzaffer Ali · Perşembe saat 17:25'de

Merhaba.

Alternatif

Kod:

Sub Yildiz_Ciz()
    Dim Cap As Integer
    Cap = InputBox("Çap belirtiniz.", vbExclamation)
    ActiveSheet.Shapes.AddShape(msoShape8pointStar, 50, 50, Cap, Cap).Select
End Sub

unalmetin · Perşembe saat 17:37'de

muhasebeciyiz' Alıntı:

Kod:

Sub DrawSelcukluStar()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)
   
    Dim diameter As Double
    Dim armWidth As Double
    Dim centerX As Double
    Dim centerY As Double
 
    diameter = Application.InputBox("Desenin çapını girin:", Type:=1)
    armWidth = Application.InputBox("Kol genişliğini girin:", Type:=1)
   
    centerX = ws.Cells(1, 1).Width + diameter / 2
    centerY = ws.Cells(1, 1).Height + diameter / 2
 
    ws.Shapes.SelectAll
    Selection.Delete
 
    Dim i As Integer
    Dim angle As Double
    Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    Dim outerRadius As Double, innerRadius As Double
   
    outerRadius = diameter / 2
    innerRadius = (outerRadius - armWidth) / 2
   
    For i = 0 To 7
        angle = i * 45 * WorksheetFunction.Pi / 180
        x1 = centerX + outerRadius * Cos(angle)
        y1 = centerY - outerRadius * Sin(angle)
        x2 = centerX + innerRadius * Cos(angle + 22.5 * WorksheetFunction.Pi / 180)
        y2 = centerY - innerRadius * Sin(angle + 22.5 * WorksheetFunction.Pi / 180)
     
        ws.Shapes.AddLine centerX, centerY, x1, y1
        ws.Shapes.AddLine x1, y1, x2, y2
    Next i
 
    ws.Shapes.AddShape msoShapeOval, centerX - innerRadius, centerY - innerRadius, 2 * innerRadius, 2 * innerRadius
   
End Sub

Bu kod, Selçuklu yıldızının sekiz köşesini çizer. Kullanıcıdan alınan çap ve kol genişliği bilgileri ile deseni çizer. VBA kodu temel geometrik hesaplamalar kullanarak her bir kolun başlangıç ve bitiş noktalarını belirler ve ardından bunları çizer.

İlk değer 250 yazdım sonraki değer 75 yazdım deseni çizdi. Denermisiniz

Sayın muhasebeciyiz arkadaşım cevabınız için çok teşekkür ederim. Bakacağım çizime

unalmetin · Perşembe saat 17:38'de

Muzaffer Ali' Alıntı:

Merhaba.

Alternatif

Kod:

Sub Yildiz_Ciz()
    Dim Cap As Integer
    Cap = InputBox("Çap belirtiniz.", vbExclamation)
    ActiveSheet.Shapes.AddShape(msoShape8pointStar, 50, 50, Cap, Cap).Select
End Sub

Sayın Muzaffer ali bey cevabınız için çok teşekkürler. Deneyeceğim

unalmetin · Perşembe saat 17:57'de

muhasebeciyiz' Alıntı:

Kod:

Sub DrawSelcukluStar()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1)
   
    Dim diameter As Double
    Dim armWidth As Double
    Dim centerX As Double
    Dim centerY As Double
 
    diameter = Application.InputBox("Desenin çapını girin:", Type:=1)
    armWidth = Application.InputBox("Kol genişliğini girin:", Type:=1)
   
    centerX = ws.Cells(1, 1).Width + diameter / 2
    centerY = ws.Cells(1, 1).Height + diameter / 2
 
    ws.Shapes.SelectAll
    Selection.Delete
 
    Dim i As Integer
    Dim angle As Double
    Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
    Dim outerRadius As Double, innerRadius As Double
   
    outerRadius = diameter / 2
    innerRadius = (outerRadius - armWidth) / 2
   
    For i = 0 To 7
        angle = i * 45 * WorksheetFunction.Pi / 180
        x1 = centerX + outerRadius * Cos(angle)
        y1 = centerY - outerRadius * Sin(angle)
        x2 = centerX + innerRadius * Cos(angle + 22.5 * WorksheetFunction.Pi / 180)
        y2 = centerY - innerRadius * Sin(angle + 22.5 * WorksheetFunction.Pi / 180)
     
        ws.Shapes.AddLine centerX, centerY, x1, y1
        ws.Shapes.AddLine x1, y1, x2, y2
    Next i
 
    ws.Shapes.AddShape msoShapeOval, centerX - innerRadius, centerY - innerRadius, 2 * innerRadius, 2 * innerRadius
   
End Sub

Bu kod, Selçuklu yıldızının sekiz köşesini çizer. Kullanıcıdan alınan çap ve kol genişliği bilgileri ile deseni çizer. VBA kodu temel geometrik hesaplamalar kullanarak her bir kolun başlangıç ve bitiş noktalarını belirler ve ardından bunları çizer.

İlk değer 250 yazdım sonraki değer 75 yazdım deseni çizdi. Denermisiniz

Sayın muhasebeciyiz Arkadaşım zaman ayırdığınız için çok teşekkür ederim. Evet çizim yapıyor. Fakat benim dediğim desen tam olarak bu değil. sayfaya resim linkini eklemeye çalışayım. https://resimlink.com/EjhsQe1B4t

unalmetin · Perşembe saat 17:59'de

Muzaffer Ali' Alıntı:

Merhaba.

Alternatif

Kod:

Sub Yildiz_Ciz()
    Dim Cap As Integer
    Cap = InputBox("Çap belirtiniz.", vbExclamation)
    ActiveSheet.Shapes.AddShape(msoShape8pointStar, 50, 50, Cap, Cap).Select
End Sub

Sayın muzaffer Ali bey bahsettiğim desenin linkini ekledim.Bu şekilde bir desen çizilebilir mi? teşekkür ederim ilginize. https://resimlink.com/EjhsQe1B4t

Haluk · Perşembe saat 18:11'de

Bir referans noktaya göre her bir noktanın "x" ve "y" koordinatlarını önceden elle hesaplayıp Excel'de hazırlanacak makroya vermelisiniz.

Eğer doğru koordinatları verirseniz, Mona Lisa tablosu bile çizdirebilirsiniz.

.

Muzaffer Ali · Perşembe saat 18:13'de

unalmetin' Alıntı:
Sayın muzaffer Ali bey bahsettiğim desenin linkini ekledim.Bu şekilde bir desen çizilebilir mi? teşekkür ederim ilginize. https://resimlink.com/EjhsQe1B4t

Buraya eklediğiniz resmi kulansanız olmaz mı?
Sadece en boy oranı ayarlaması yapılır ve daha hızlı bir sonuç elde edilir.

Korhan Ayhan · Cuma saat 00:31'de

Haluk beyin ifadesinden sonra linkteki çalışma aklıma geldi..

Haluk' Alıntı:
Eğer doğru koordinatları verirseniz, Mona Lisa tablosu bile çizdirebilirsiniz.

https://www.excel.web.tr/threads/excelde-sanat-reloaded.1480/

Tevfik_Kursun · Cuma saat 08:09'de

Zihninize sağlık Korhan Hocam,
Harika bir çalışma. Bravo, tebrikler ...

unalmetin · Cuma saat 09:01'de

Muzaffer Ali' Alıntı:
Buraya eklediğiniz resmi kulansanız olmaz mı?
Sadece en boy oranı ayarlaması yapılır ve daha hızlı bir sonuç elde edilir.

Muzaffer Ali hocam size ve diğer cevap yazan bütün arkadaşlarımıza teşekkür ederim cevaplarınız için. Ben VBA bilmediğim için bir proje düşünmüştüm. excel de desen çizdirip Autocad programına dxf olarak göndersin ya da direk Autocad içine çizebilsin şeklinde düşünüyordum. Verilen cevaplardan her türlü çizimin excel vba ile çizilebileceğini anladım.

Korhan Ayhan · Cuma saat 09:57'de

Tevfik_Kursun' Alıntı:
Zihninize sağlık Korhan Hocam,
Harika bir çalışma. Bravo, tebrikler ...

Çalışma bana ait değil... Sadece paylaşımda bulundum..

Tevfik_Kursun · Cuma saat 10:01'de

Sayın Korhan Ayhan Hocam,
Ben de hatırlamanız için yazmıştım. Konu 20 sene öncesine ait.
Saygılarımla

Haluk · Cuma saat 10:43'de

Vektörel çizim yapılmasıyla ilgili olarak, aşağıdaki linkte Excel VBA ile çelik kafes kiriş hesabı ve çelik yapının çizimi yapılmakta olup, 2. sayfadaki animasyonda verilmiştir.

Çelik makas çözümü ... | Excel WEB TR Forum - Excel, Excel Makro, Excel Fonksiyon, Excel Formül, Excel soru ve çözümleri

.

unalmetin · Cuma saat 10:45'de

Haluk' Alıntı:
Vektörel çizim yapılmasıyla ilgili olarak, aşağıdaki linkte Excel VBA ile çelik kafes kiriş hesabı ve çelik yapının çizimi yapılmakta olup, 2. sayfadaki animasyonda verilmiştir.

Çelik makas çözümü ... | Excel WEB TR Forum - Excel, Excel Makro, Excel Fonksiyon, Excel Formül, Excel soru ve çözümleri

.

Haluk bey teşekkür ederim paylaşım için

Zeki Gürsoy · Cuma saat 10:52'de

Windows gdi/gdiplus ile form üzerine veya virtual bitmap üzerine çizilerek diske kaydedilebilir. VBA uyarlamasını iki defa başlayıp zaman problemi nedeniyle devamını getiremedim. Umarım bir gün yine başlayıp devamını getiririm. Zira kapsamlı bir konu...

.

EXCEL VBA İLE GEOMETRİK DESEN ÇİZİLEBİLİR Mİ

unalmetin

muhasebeciyiz

Muzaffer Ali

Destek Ekibi

unalmetin

unalmetin

unalmetin

unalmetin

Haluk

𐱅𐰇𐰼𐰚

Muzaffer Ali

Destek Ekibi

Korhan Ayhan

Administrator

Tevfik_Kursun

unalmetin

Korhan Ayhan

Administrator

Tevfik_Kursun

Haluk

𐱅𐰇𐰼𐰚

unalmetin

Zeki Gürsoy

Uzman