• Çizim Okulu
    Forum İndir Galeri Youtube Turkish English Deutsch Français Japanese
    Forum Download Galeri AboneOl

    Üye Ol veya Giriş Yap

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
Dwg Paylaş Family Paylaş
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 lar
AutoCAD Genel
  • AutoCAD
  • AutoLISP
  • AutoCAD Programlama
  • AutoCAD Püfleri-1
  • AutoCAD Püfleri-2
  • AutoCAD Komutları
  • AutoCAD Terimler Sözl.
AutoCAD Eğitimi
  • AutoCAD Eğitim Videoları
  • AutoCAD Eğitimi
  • AutoCAD Dersleri
  • AutoCAD Eğitim Notları
  • AutoCAD 3 Boyut Dersleri
3ds Max
  • 3ds Max Nedir?
  • 3ds Max Model ve Çizim
Ö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
Program Ekle
Ziyaretçi: 557, Üye: 3
ali3235, bnazım, dembaha
Detaylar »
> Programlama > N Bilinmeyenli N Doğrusal Denklem Çözümü

N Bilinmeyenli N Doğrusal Denklem Çözümü

NxN Kare Matris Hesaplaması
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

Yazar: Harun KILIÇ
İçerik: Harun KILIÇ
Tag: N Bilinmeyenli N Doğrusal Denklem Çözümü NxN Kare Matris Hesaplaması

Benzer Sayfalar
Benzer konu bulunamadı.
Yorumlar :
hyr   23.01.2010 11:49 #12340  

MsgBox "Burası AutoCad Okulu." & vbCrLf & "Lütfen yazdığınız form başlığına bakarak tekrar deneyiniz", 16, "Hata"

bturcan   07.01.2009 15:08 #10101  

çok güzel

cunal   28.08.2007 12:14 #5272  

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.

Copyright © 2004-2026 | Tüm Hakları Saklıdır | 4050 | Site haritası | İstatistikler | Hakkımızda | Kadromuz | Gizlilik | Reklam | İletişim
SQL: 0.051 saniye - Sorgu: 37 - Ortalama: 0.00139 saniye | Insurance Quote Guide