Forumdan
99 kategoride
17 binden fazla konu başlatıldı
bu konulara yaklaşık 90 bin cevap verildi
tüm bunlar yaklaşık 109 milyon kez görüntülendi
Bölüm indeksi
Makaleler
Sık Sorulan Sorular
Download
İzle Öğren
Eğitim Videoları

3ds Max Videoları
AutoCAD Kursu Ders Videoları

AutoCAD Kursu 2 Boyut Dersleri
Proje Dökümanları
Çizimler

Mimari Çizimler

Elektrik

Doğalgaz

Harita Çizimleri

Tesisat

Ferforje

Makine

3 Boyut

3ds Max

ArchiCAD

Solidworks

Diğer Çizimler
Revit Family
Lispler
Menüler
Fontlar
FreeMUST
Eğitim Dökümanları
Genel Kategori
Çizim Programları
IES Dökümanları
AutoCAD
AutoLISP

Konu Anlatımları

Örnek Lispler
Sürümler
Menüler
DWF Dosyaları
Programlama

AutoCAD VB > Exce...

AutoCAD VBA Makro...

AutoCAD’de...

C ve C++ ile Auto...

C++ ile ARX progr...

N Bilinmeyenli N...

VB veya Not Defte...

Visual Basic 6.0...

Visual Basic dosy...
AutoCAD Püfleri
Eğitim

AutoCAD Eğitimi

Karma 3 Boyut Dersleri

Adım Adım AutoCAD Eğitimi


01.Bölüm


02.Bölüm


03.Bölüm


04.Bölüm


05.Bölüm


06.Bölüm


07.Bölüm


08.Bölüm


09.Bölüm


10.Bölüm


11.Bölüm


12.Bölüm


Uygulamalar

Adım Adım 3 Boyut Eğitimi
Kariyer
3ds Max
Attribute larAutoCAD Genel
AutoCAD Eğitimi
3ds Max
Özel Yazılımlar
- aLd Fonksiyonu
- TCad Metraj
- FacadeCAD
- Cephe Kot
- HQ Library
- FreeMUST
- ALS/Pasdoc.A
- Excele Tablo Aktaran Lisp
- Nokta Koordinat Tablosu
- Plana İç Ölçü Verme
- Toplam Alanı Yazan Lisp
- Alan ve Çevre Yazan Lisp
- Koordinat, Alan ve Çevre Tablo Halinde Yazma
- AutoCAD'de Nokta Dökümü
- Hava Kanalı Metraj Fonksiyonu
- Boru Metrajı Fonksiyonu
- OptiCAD
- Özel Çizgi Tipi Oluşturmak
- AutoCAD te Koni Açılımı Nasıl Yapılır?
- PolyLine & Point Objelerinden Aplikasyon Çizelgesi
- Z değerini sıfırlama
- AutoCAD te Polyline üzerine uzunluk yazdırma
- Sıralı numaralandırma
- Yazı içindeki sayıları toplama
- Karmaşık Path ile Loft Uygulaması
- Çoklu Fillet Fonksiyonu
- Ölçekli Türk Bayrağı çizen lisp
- Duvar-Lento-Kapı-Pencere Metraj Programı
- Demir (Donatı) Metraj LISP'i
Ortak Türk Alfabesi 34 harf destekli fontlar
N Bilinmeyenli N Doğrusal Denklem Çözümü
NxN Kare Matris Hesaplaması
harunkilic - 19.09.2006 13:40
harunkilic - 19.09.2006 13:40
Visual Basic 6.0 ile yazılmış BİLGİSAYAR PROGRAMI KODU

Option Explicit
'//// Visual Basic 6.0
'//// N Bilinmeyenli N Dogrusal Denklem Cozumu
'//// NxN KARE MATRIS
Public Type MatNxN
A() As Double
Minor() As Double
Determinant As Double
CoFactor() As Double
Transpose() As Double
Inverse() As Double
End Type
Public Type EQN_
N As Long
MATRIS As MatNxN
SABITLER() As Double
SONUCLAR() As Double
End Type
Public EQN As EQN_
Public Function _
DeterminantOf(SqrMatrix() As Double) As Double
Dim i As Integer
Dim j As Integer
Dim CalcTotal As Double
For i = 1 To 1
For j = 1 To UBound(SqrMatrix)
CalcTotal = CalcTotal + SqrMatrix(i, j) * (-1) ^ (i + j) * MinorOf(SqrMatrix, i, j)
Next j
Next i
DeterminantOf = CalcTotal
End Function
Public Function _
MinorOf(SqrMatrix() As Double, EntityRowID As Integer, _
EntityColID As Integer) As Double
If UBound(SqrMatrix) = 1 Then Exit Function
Dim SubMatrix() As Double
DetermineSubMatrix SqrMatrix, EntityRowID, EntityColID, SubMatrix
If UBound(SubMatrix) = 1 Then
MinorOf = SubMatrix(1, 1)
Else
MinorOf = DeterminantOf(SubMatrix)
End If
End Function
Public Sub _
DetermineSubMatrix(SqrMatrix() As Double, EntityRowID As Integer, _
EntityColID As Integer, SubMatrix() As Double)
Dim i As Integer
Dim j As Integer
Dim subI As Integer
Dim subJ As Integer
ReDim SubMatrix(1 To UBound(SqrMatrix) - 1, 1 To UBound(SqrMatrix) - 1)
subI = 1: subJ = 1
For i = 1 To UBound(SqrMatrix)
If i = EntityRowID Then i = i + 1
For j = 1 To UBound(SqrMatrix)
If j = EntityColID Then j = j + 1
SubMatrix(subI, subJ) = SqrMatrix(i, j)
subJ = subJ + 1
If subJ = UBound(SqrMatrix) Then Exit For
Next j
subI = subI + 1
subJ = 1
If subI = UBound(SqrMatrix) Then Exit For
Next i
End Sub
Public Sub _
GetTransposeAndInverse(CoFactor() As Double, Transpose() As Double, _
Inverse() As Double, Det As Double)
Dim i As Integer
Dim j As Integer
For i = 1 To UBound(CoFactor)
For j = UBound(CoFactor) To 1 Step -1
Transpose(j, i) = CoFactor(i, j)
Inverse(j, i) = Transpose(j, i) / Det
Next j
Next i
End Sub
Public Sub Main()
With EQN
'Denklem sayisini kendi ihtiyaciniza gore degistirin, pozitif tamsayi olmalıdır.
.N = 4
ReDim .SABITLER(1 To EQN.N)
ReDim .MATRIS.A(1 To EQN.N, 1 To EQN.N)
' ORNEK DENKLEMLER - BASLANGIC
' X=x1=1 Y=x2=1 Z=x3=1 W=x4=1
' 3X + 4Y + Z + 5W = 13
' 5X + 2Y - 2Z - W = 4
' -2X + Y + 3Z + 2W = 4
' -9X - Y + 2Z + 2W = -6
'Denklem sayisini kadar katsayilarinizi ve sabit degerlerinizi girin, bu örnekte
'4 adet dogrusal denklem kullanilmistir
'1 numarali denklem
.MATRIS.A(1, 1) = 3 'Katsayi X1
.MATRIS.A(1, 2) = 4 'Katsayi X2
.MATRIS.A(1, 3) = 1 'Katsayi X3
.MATRIS.A(1, 4) = 5 'Katsayi X4
.SABITLER(1) = 13 'denklem sonucu sabit sayi
'2 numarali denklem
.MATRIS.A(2, 1) = 5
.MATRIS.A(2, 2) = 2
.MATRIS.A(2, 3) = -2
.MATRIS.A(2, 4) = -1
.SABITLER(2) = 4
'3 numarali denklem
.MATRIS.A(3, 1) = -2
.MATRIS.A(3, 2) = 1
.MATRIS.A(3, 3) = 3
.MATRIS.A(3, 4) = 2
.SABITLER(3) = 4
'4 numarali denklem
.MATRIS.A(4, 1) = -9
.MATRIS.A(4, 2) = -1
.MATRIS.A(4, 3) = 2
.MATRIS.A(4, 4) = 2
.SABITLER(4) = -6
' ORNEK DENKLEMLER - BITIS
ReDim .MATRIS.CoFactor(1 To .N, 1 To .N)
ReDim .MATRIS.Inverse(1 To .N, 1 To .N)
ReDim .MATRIS.Minor(1 To .N, 1 To .N)
ReDim .MATRIS.Transpose(1 To .N, 1 To .N)
Dim i As Integer
Dim j As Integer
For i = 1 To .N
For j = 1 To .N
.MATRIS.Minor(i, j) = MinorOf(.MATRIS.A, i, j)
.MATRIS.CoFactor(i, j) = (-1) ^ (i + j) * .MATRIS.Minor(i, j)
Next j
Next i
.MATRIS.Determinant = DeterminantOf(.MATRIS.A)
If .MATRIS.Determinant = 0 Then
MsgBox "COZUM BULUNAMIYOR! det(A)=0"
Exit Sub
End If
GetTransposeAndInverse .MATRIS.CoFactor, .MATRIS.Transpose, _
.MATRIS.Inverse, .MATRIS.Determinant
ReDim .SONUCLAR(1 To .N)
Dim X As Double
For i = 1 To .N
For j = 1 To .N
X = X + .MATRIS.Inverse(i, j) * .SABITLER(j)
Next j
.SONUCLAR(i) = X
MsgBox "x" & (i) & " = " & Format(.SONUCLAR(i), "#0.00000000")
X = 0#
Next i
MsgBox "Katsayilari ve sabitleri Excel dosyasindan alan kod için:" & vbCr & _
"hrnkilic@gmail.com"
End With
End Sub

Option Explicit
'//// Visual Basic 6.0
'//// N Bilinmeyenli N Dogrusal Denklem Cozumu
'//// NxN KARE MATRIS
Public Type MatNxN
A() As Double
Minor() As Double
Determinant As Double
CoFactor() As Double
Transpose() As Double
Inverse() As Double
End Type
Public Type EQN_
N As Long
MATRIS As MatNxN
SABITLER() As Double
SONUCLAR() As Double
End Type
Public EQN As EQN_
Public Function _
DeterminantOf(SqrMatrix() As Double) As Double
Dim i As Integer
Dim j As Integer
Dim CalcTotal As Double
For i = 1 To 1
For j = 1 To UBound(SqrMatrix)
CalcTotal = CalcTotal + SqrMatrix(i, j) * (-1) ^ (i + j) * MinorOf(SqrMatrix, i, j)
Next j
Next i
DeterminantOf = CalcTotal
End Function
Public Function _
MinorOf(SqrMatrix() As Double, EntityRowID As Integer, _
EntityColID As Integer) As Double
If UBound(SqrMatrix) = 1 Then Exit Function
Dim SubMatrix() As Double
DetermineSubMatrix SqrMatrix, EntityRowID, EntityColID, SubMatrix
If UBound(SubMatrix) = 1 Then
MinorOf = SubMatrix(1, 1)
Else
MinorOf = DeterminantOf(SubMatrix)
End If
End Function
Public Sub _
DetermineSubMatrix(SqrMatrix() As Double, EntityRowID As Integer, _
EntityColID As Integer, SubMatrix() As Double)
Dim i As Integer
Dim j As Integer
Dim subI As Integer
Dim subJ As Integer
ReDim SubMatrix(1 To UBound(SqrMatrix) - 1, 1 To UBound(SqrMatrix) - 1)
subI = 1: subJ = 1
For i = 1 To UBound(SqrMatrix)
If i = EntityRowID Then i = i + 1
For j = 1 To UBound(SqrMatrix)
If j = EntityColID Then j = j + 1
SubMatrix(subI, subJ) = SqrMatrix(i, j)
subJ = subJ + 1
If subJ = UBound(SqrMatrix) Then Exit For
Next j
subI = subI + 1
subJ = 1
If subI = UBound(SqrMatrix) Then Exit For
Next i
End Sub
Public Sub _
GetTransposeAndInverse(CoFactor() As Double, Transpose() As Double, _
Inverse() As Double, Det As Double)
Dim i As Integer
Dim j As Integer
For i = 1 To UBound(CoFactor)
For j = UBound(CoFactor) To 1 Step -1
Transpose(j, i) = CoFactor(i, j)
Inverse(j, i) = Transpose(j, i) / Det
Next j
Next i
End Sub
Public Sub Main()
With EQN
'Denklem sayisini kendi ihtiyaciniza gore degistirin, pozitif tamsayi olmalıdır.
.N = 4
ReDim .SABITLER(1 To EQN.N)
ReDim .MATRIS.A(1 To EQN.N, 1 To EQN.N)
' ORNEK DENKLEMLER - BASLANGIC
' X=x1=1 Y=x2=1 Z=x3=1 W=x4=1
' 3X + 4Y + Z + 5W = 13
' 5X + 2Y - 2Z - W = 4
' -2X + Y + 3Z + 2W = 4
' -9X - Y + 2Z + 2W = -6
'Denklem sayisini kadar katsayilarinizi ve sabit degerlerinizi girin, bu örnekte
'4 adet dogrusal denklem kullanilmistir
'1 numarali denklem
.MATRIS.A(1, 1) = 3 'Katsayi X1
.MATRIS.A(1, 2) = 4 'Katsayi X2
.MATRIS.A(1, 3) = 1 'Katsayi X3
.MATRIS.A(1, 4) = 5 'Katsayi X4
.SABITLER(1) = 13 'denklem sonucu sabit sayi
'2 numarali denklem
.MATRIS.A(2, 1) = 5
.MATRIS.A(2, 2) = 2
.MATRIS.A(2, 3) = -2
.MATRIS.A(2, 4) = -1
.SABITLER(2) = 4
'3 numarali denklem
.MATRIS.A(3, 1) = -2
.MATRIS.A(3, 2) = 1
.MATRIS.A(3, 3) = 3
.MATRIS.A(3, 4) = 2
.SABITLER(3) = 4
'4 numarali denklem
.MATRIS.A(4, 1) = -9
.MATRIS.A(4, 2) = -1
.MATRIS.A(4, 3) = 2
.MATRIS.A(4, 4) = 2
.SABITLER(4) = -6
' ORNEK DENKLEMLER - BITIS
ReDim .MATRIS.CoFactor(1 To .N, 1 To .N)
ReDim .MATRIS.Inverse(1 To .N, 1 To .N)
ReDim .MATRIS.Minor(1 To .N, 1 To .N)
ReDim .MATRIS.Transpose(1 To .N, 1 To .N)
Dim i As Integer
Dim j As Integer
For i = 1 To .N
For j = 1 To .N
.MATRIS.Minor(i, j) = MinorOf(.MATRIS.A, i, j)
.MATRIS.CoFactor(i, j) = (-1) ^ (i + j) * .MATRIS.Minor(i, j)
Next j
Next i
.MATRIS.Determinant = DeterminantOf(.MATRIS.A)
If .MATRIS.Determinant = 0 Then
MsgBox "COZUM BULUNAMIYOR! det(A)=0"
Exit Sub
End If
GetTransposeAndInverse .MATRIS.CoFactor, .MATRIS.Transpose, _
.MATRIS.Inverse, .MATRIS.Determinant
ReDim .SONUCLAR(1 To .N)
Dim X As Double
For i = 1 To .N
For j = 1 To .N
X = X + .MATRIS.Inverse(i, j) * .SABITLER(j)
Next j
.SONUCLAR(i) = X
MsgBox "x" & (i) & " = " & Format(.SONUCLAR(i), "#0.00000000")
X = 0#
Next i
MsgBox "Katsayilari ve sabitleri Excel dosyasindan alan kod için:" & vbCr & _
"hrnkilic@gmail.com"
End With
End Sub
Yazar: Harun KILIÇ
İçerik: Harun KILIÇ
Tag: N Bilinmeyenli N Doğrusal Denklem Çözümü NxN Kare Matris Hesaplaması
Benzer SayfalarBenzer konu bulunamadı.
Yorumlar :
MsgBox "Burası AutoCad Okulu." & vbCrLf & "Lütfen yazdığınız form başlığına bakarak tekrar deneyiniz", 16, "Hata"
Harun bey eline saglık,
iyi güzel yazmıssın lakin ben programcı degilim, ama hevesliyim.
Bu ne işimize yarar nerede kullanabiliriz.
Şoyle bide acıklayıcı bilgilendirici birde yorum yazsan çok mutlu edersin beni.
inanıyorumki başkalarıda cok mutlu olur bu duruma.





