Excel'den AutuCAD'e veri aktarma

[cocoa35]

iyi günler arkadaşlar;Ben yapmış olduğum Excel programından verileri otomatik olarak AutoCAD'e aktarmayı istiyorum bu mümkünmü? Örnek olarak vermek istersek Excelde boyutları belli olan bir dikdörtgenin A:5m B:15m AutoCAD'de cizdirilmesi mümkünmü bu konudaki yardımlarınız için şimdiden çok teşekkür ederim.

 

[uzmanamele]

merhaba
bu söylediğiniz malesef mümkün değil.
konu, excelin özelliği değil autocad in özelliği zaten

 

[mesuttasar]

Excelden yapılırmı bilmem rastlamadım ama AutoCAD için yazılmış olan lisp ler , txt dosyalarından x,y,z koordinatlarını alıp , aralarına gerekli line ları çizebiliyor.

 

[ockucukay]

bir autocad kullanıcısı olarak söyleyebilirimki istemiş olduğunuz şeyi autocad zaten yapıyor. ama exceldeki bir tabloyu autocada gömmek isterseniz onun ayrıca yolları var. ustalarım reklam olarak almazlar umarım excel web tr gibi bir forum sitesindenwww.autocadokulu.com yararlanabilirsiniz.

 

[omerceri]

Ekteki örnekte hem formdaki değişken verileri, hem de kod modülündeki fiks verileri kullanarak autocad dosyasında çizim yapıyor. Siz hücrelerdeki verilere göre çizim yapacak şekilde de ayarlayabilirsiniz

 

[uzmanamele]

merhaba
syn omerceri, dosyanız açılmıyor, tekrar ekler misiniz

 

[omerceri]

excel dosyası olarak ekliyorum. autocad yüklü olması gerekiyor.

 

[uzmanamele]

merhaba
dosya açılırken hata mesajı veriyor, tüm excel uygulamalarını kapatıyor.
dosyanızda vba kodu var ise bu kodları yazar mısınız?

 

[omerceri]

Private Sub CommandButton1_Click()
fazla = taban.Value
If fazla = "" Then
MsgBox "PLATFORM YÜKSKLİĞİ BELİRTİNİZ"
taban.SetFocus
Exit Sub
End If
If X1 = "" Then
MsgBox "DEĞER GİRMEDİNİZ."
X1.SetFocus
Exit Sub
End If
If Y1 = "" Then
MsgBox "DEĞER GİRMEDİNİZ."
Y1.SetFocus
Exit Sub
End If
If X2 = "" Then
MsgBox "DEĞER GİRMEDİNİZ."
X2.SetFocus
Exit Sub
End If
If Y2 = "" Then
MsgBox "DEĞER GİRMEDİNİZ."
Y2.SetFocus
Exit Sub
End If
For j = 1 To 20
If (Controls("X" & j).Text <> "" And Controls("Y" & j).Text = "") Then
MsgBox "HER X DE&#286;ER&#304; &#304;&#199;&#304;N B&#304;R Y DE&#286;ER&#304; G&#304;R&#304;N&#304;Z"
Controls("Y" & j).SetFocus
Exit Sub
End If
If (Controls("Y" & j).Text <> "" And Controls("X" & j).Text = "") Then
MsgBox "HER Y DE&#286;ER&#304; &#304;&#199;&#304;N B&#304;R X DE&#286;ER&#304; G&#304;R&#304;N&#304;Z"
Controls("X" & j).SetFocus
Exit Sub
End If
Next
Dim Cad As AutoCAD.AcadApplication
Set Cad = New AutoCAD.AcadApplication
Cad.Application.ActiveDocument.SaveAs ActiveWorkbook.Path & "/" & _
Replace(ActiveWorkbook.Name, ".xls", ".dwg")

Cad.Visible = False
Cad.Application.WindowState = acMin
Cad.ActiveDocument.SendCommand "lwdisplay on " & (Chr(27) & Chr(27))

Dim aline As AutoCAD.AcadLine
Dim endPoint(0 To 2) As Double
Dim startPoint(0 To 2) As Double
Dim dimObj As AutoCAD.AcadDimOrdinate
Dim useXAxis As Long
useXAxis = 0#

For i = 0 To 4800 Step 100

startPoint(0) = -2000: startPoint(1) = i: startPoint(2) = 0#
endPoint(0) = 2000: endPoint(1) = i: endPoint(2) = 0#
Set aline = Cad.Application.ActiveDocument.ModelSpace.AddLine(startPoint, endPoint)
Set dimObj = Cad.Application.ActiveDocument.ModelSpace.AddDimOrdinate(endPoint, endPoint, useXAxis)
dimObj.VerticalTextPosition = acVertCentered
dimObj.TextHeight = 65
endPoint(0) = 2200
dimObj.TextPosition = endPoint
dimObj.ExtensionLineColor = 253
Set dimObj = Cad.Application.ActiveDocument.ModelSpace.AddDimOrdinate(startPoint, startPoint, useXAxis)
dimObj.VerticalTextPosition = acVertCentered
dimObj.TextHeight = 65
endPoint(0) = -2200
dimObj.TextPosition = endPoint
dimObj.ExtensionLineColor = 253
Next
For e = -2000 To 2000 Step 100

startPoint(0) = e
startPoint(1) = 0
startPoint(2) = 0#
endPoint(0) = e
endPoint(1) = 4800
endPoint(2) = 0#
useXAxis = 1#
Set aline = Cad.Application.ActiveDocument.ModelSpace.AddLine(startPoint, endPoint)
Set dimObj = Cad.Application.ActiveDocument.ModelSpace.AddDimOrdinate(endPoint, endPoint, useXAxis)
dimObj.VerticalTextPosition = acVertCentered
dimObj.TextHeight = 65
endPoint(1) = 5000
dimObj.TextPosition = endPoint
dimObj.ExtensionLineColor = 253

If e = 0 Then
aline.Color = acBlue
Else
aline.Color = acByLayer
End If
Next
If ListBox1 = "ED&#304;RNE-HALKALI" Then
ReDim yapi(0 To 1, 0 To 16)
yapi(0, 0) = 831.5: yapi(1, 0) = 55
yapi(0, 1) = 1200: yapi(1, 1) = 55
yapi(0, 2) = 1575: yapi(1, 2) = 380
yapi(0, 3) = 1700: yapi(1, 3) = 380
yapi(0, 4) = 1700: yapi(1, 4) = 1120
yapi(0, 5) = 2000: yapi(1, 5) = 1120
yapi(0, 6) = 2000: yapi(1, 6) = 3500
yapi(0, 7) = 800: yapi(1, 7) = 4800
yapi(0, 8) = -800: yapi(1, 8) = 4800
yapi(0, 9) = -2000: yapi(1, 9) = 3500
yapi(0, 10) = -2000: yapi(1, 10) = 760
yapi(0, 11) = -1725: yapi(1, 11) = 760
yapi(0, 12) = -1725: yapi(1, 12) = 380
yapi(0, 13) = -1575: yapi(1, 13) = 380
yapi(0, 14) = -1200: yapi(1, 14) = 55
yapi(0, 15) = -831.5: yapi(1, 15) = 55
yapi(0, 16) = -831.5: yapi(1, 16) = 55
ElseIf ListBox1 = "TCDD" Then
ReDim yapi(0 To 1, 0 To 18)
yapi(0, 0) = 831.5: yapi(1, 0) = 55
yapi(0, 1) = 1225: yapi(1, 1) = 55
yapi(0, 2) = 1600: yapi(1, 2) = 380
yapi(0, 3) = 1700: yapi(1, 3) = 380
yapi(0, 4) = 1700: yapi(1, 4) = 1120
yapi(0, 5) = 2000: yapi(1, 5) = 1120
yapi(0, 6) = 2000: yapi(1, 6) = 3000
yapi(0, 7) = 1600: yapi(1, 7) = 3800
yapi(0, 8) = 800: yapi(1, 8) = 4800
yapi(0, 9) = -800: yapi(1, 9) = 4800
yapi(0, 10) = -1600: yapi(1, 10) = 3800
yapi(0, 11) = -2000: yapi(1, 11) = 3000
yapi(0, 12) = -2000: yapi(1, 12) = 760
yapi(0, 13) = -1700: yapi(1, 13) = 760
yapi(0, 14) = -1700: yapi(1, 14) = 380
yapi(0, 15) = -1600: yapi(1, 15) = 380
yapi(0, 16) = -1225: yapi(1, 16) = 55
yapi(0, 17) = -831.5: yapi(1, 17) = 55
yapi(0, 18) = -831.5: yapi(1, 18) = 55
End If
If ListBox1 = "ED&#304;RNE-HALKALI" Then
uz = 15
ElseIf ListBox1 = "TCDD" Then
uz = 17
End If
For ii = 0 To uz
startPoint(0) = yapi(0, ii + 1)
startPoint(1) = yapi(1, ii + 1)
startPoint(2) = 0#

endPoint(0) = yapi(0, ii)
endPoint(1) = yapi(1, ii)
endPoint(2) = 0#

Set aline = Cad.Application.ActiveDocument.ModelSpace.AddLine(startPoint, endPoint)
aline.Color = acRed
aline.Lineweight = acLnWt100
Set aline = Cad.Application.ActiveDocument.ModelSpace.AddLine(startPoint, endPoint)
aline.Color = acByLayer
aline.Lineweight = acLnWt020
Next

If ListBox1 = "ED&#304;RNE-HALKALI" Then
ReDim YUK(0 To 1, 0 To 24)
YUK(0, 0) = 831.5: YUK(1, 0) = 0
YUK(0, 1) = 831.5: YUK(1, 1) = 110
YUK(0, 2) = 1010: YUK(1, 2) = 110
YUK(0, 3) = 1180: YUK(1, 3) = 210
YUK(0, 4) = 1225: YUK(1, 4) = 210
YUK(0, 5) = 1410: YUK(1, 5) = 360
YUK(0, 6) = 1490: YUK(1, 6) = 360
YUK(0, 7) = 1490: YUK(1, 7) = 430
YUK(0, 8) = 1575: YUK(1, 8) = 430
YUK(0, 9) = 1575: YUK(1, 9) = 3500
YUK(0, 10) = 1280: YUK(1, 10) = 4080
YUK(0, 11) = 754: YUK(1, 11) = 4650
YUK(0, 12) = -754: YUK(1, 12) = 4650
YUK(0, 13) = -1280: YUK(1, 13) = 4080
YUK(0, 14) = -1575: YUK(1, 14) = 3500
YUK(0, 15) = -1575: YUK(1, 15) = 430
YUK(0, 16) = -1490: YUK(1, 16) = 430
YUK(0, 17) = -1490: YUK(1, 17) = 360
YUK(0, 18) = -1410: YUK(1, 18) = 360
YUK(0, 19) = -1225: YUK(1, 19) = 210
YUK(0, 20) = -1180: YUK(1, 20) = 210
YUK(0, 21) = -1010: YUK(1, 21) = 110
YUK(0, 22) = -831.5: YUK(1, 22) = 110
YUK(0, 23) = -831.5: YUK(1, 23) = 0
YUK(0, 24) = -831.5: YUK(1, 24) = 0
ElseIf ListBox1 = "TCDD" Then
ReDim YUK(0 To 1, 0 To 24)
YUK(0, 0) = 831.5: YUK(1, 0) = 0
YUK(0, 1) = 831.5: YUK(1, 1) = 110
YUK(0, 2) = 1010: YUK(1, 2) = 110
YUK(0, 3) = 1180: YUK(1, 3) = 210
YUK(0, 4) = 1225: YUK(1, 4) = 210
YUK(0, 5) = 1410: YUK(1, 5) = 360
YUK(0, 6) = 1490: YUK(1, 6) = 360
YUK(0, 7) = 1490: YUK(1, 7) = 430
YUK(0, 8) = 1575: YUK(1, 8) = 430
YUK(0, 9) = 1575: YUK(1, 9) = 3500
YUK(0, 10) = 1395: YUK(1, 10) = 3805
YUK(0, 11) = 690: YUK(1, 11) = 4650
YUK(0, 12) = -690: YUK(1, 12) = 4650
YUK(0, 13) = -1395: YUK(1, 13) = 3805
YUK(0, 14) = -1575: YUK(1, 14) = 3500
YUK(0, 15) = -1575: YUK(1, 15) = 430
YUK(0, 16) = -1490: YUK(1, 16) = 430
YUK(0, 17) = -1490: YUK(1, 17) = 360
YUK(0, 18) = -1410: YUK(1, 18) = 360
YUK(0, 19) = -1225: YUK(1, 19) = 210
YUK(0, 20) = -1180: YUK(1, 20) = 210
YUK(0, 21) = -1010: YUK(1, 21) = 110
YUK(0, 22) = -831.5: YUK(1, 22) = 110
YUK(0, 23) = -831.5: YUK(1, 23) = 0
YUK(0, 24) = -831.5: YUK(1, 24) = 0
End If
For ee = 0 To 23
startPoint(0) = YUK(0, ee + 1)
startPoint(1) = YUK(1, ee + 1)
startPoint(2) = 0#

endPoint(0) = YUK(0, ee)
endPoint(1) = YUK(1, ee)
endPoint(2) = 0#

Set aline = Cad.Application.ActiveDocument.ModelSpace.AddLine(startPoint, endPoint)
aline.Color = acBlue
aline.Lineweight = acLnWt100
Set aline = Cad.Application.ActiveDocument.ModelSpace.AddLine(startPoint, endPoint)
aline.Color = acByLayer
aline.Lineweight = acLnWt020
Next


Dim son(0 To 2) As Double
Dim bas(0 To 2) As Double
qq = 1
While Controls("X" & qq + 1) <> ""
son(0) = Controls("X" & qq)
son(1) = Controls("Y" & qq) + Val(taban)
son(2) = 0#
bas(0) = Controls("X" & qq + 1)
bas(1) = Controls("Y" & qq + 1) + Val(taban)
bas(2) = 0#

Set aline = Cad.Application.ActiveDocument.ModelSpace.AddLine(son, bas)
aline.Color = acRed
aline.Lineweight = acLnWt100
Set aline = Cad.Application.ActiveDocument.ModelSpace.AddLine(son, bas)
aline.Color = acByLayer
aline.Lineweight = acLnWt020
qq = qq + 1
Wend


Cad.Application.ZoomAll
Cad.Application.ActiveDocument.Save
Cad.Application.ActiveDocument.Close
Cad.Application.Quit
WebBrowser1.Navigate (ActiveWorkbook.Path & "/orjinalgabari1.dwg")



End Sub


Private Sub CommandButton2_Click()
Application.Quit
End Sub

Private Sub Label1_Click()

End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Layout()
ListBox1.AddItem "TCDD"
ListBox1.AddItem "ED&#304;RNE-HALKALI"
ListBox1.AddItem "VAN-KAPIK&#214;Y"
WebBrowser1.Navigate (ActiveWorkbook.Path & "/orjinalgabari1.dwg")
End Sub

 

[uzmanamele]

merhaba
san&#305;r&#305;m bu kodlar&#305; kullanabilmek i&#231;in userform olu&#351;turmak gerekiyor. &#231;al&#305;&#351;t&#305;rmay&#305; beceremedim, dosyay&#305; da a&#231;amad&#305;m. nas&#305;l bi&#351;ey oldu&#287;unu merak ettim do&#287;rusu.
&#246;rnek dosyay&#305; a&#231;abilen arkada&#351; var m&#305;? benim makinem neden a&#231;mad&#305; acaba?

bu kodlar her autocad s&#252;r&#252;m&#252; i&#231;in ge&#231;erli mi?

 

[Rıdvan01]

Bende açtı

ne işe yaradığını bilmiyorum

 

[omerceri]

Sn uzmanamele
AutoCad'e ait referanslar&#305; eklemelisiniz.
Bu &#231;al&#305;&#351;may&#305; yapt&#305;&#287;&#305;mda 2002 autocad y&#252;kl&#252; idi.
Autocad y&#252;kl&#252; ise onun dosyalar&#305; aras&#305;nda excel'den veri alma &#246;rnekleri var.
Ben Autocad bilmiyorum. S&#305;rf bu i&#351; i&#231;in bir &#231;al&#305;&#351;ma yapm&#305;&#351;t&#305;m.

 

[omerceri]

eklemeniz gereken Refernslar
AutoCAD Type Library
AutoCAD/ObjectDBX Common 1.0 Type..........
Ref Edit Control
Microsoft Internet Controls

 

[uzmanamele]

merhaba
autocad_2008 kullan&#305;yorum, autocad'i bende &#231;ok iyi bilmiyorum ama &#246;nce excel dosyas&#305;n&#305; a&#231;mas&#305; laz&#305;m. veri al&#305;&#351;veri&#351;i daha sonra olmal&#305;.
ilk bak&#305;&#351;ta san&#305;r&#305;m bir masa &#231;izimi i&#231;in gerekli koordinatlar gibi g&#246;rd&#252;m ama g&#252;zel bir &#246;rnek, geli&#351;tirilebilir.

 

[omerceri]

Kusura bakmay&#305;n &#246;rne&#287;i a&#231;&#305;klamad&#305;m ba&#351;&#305;nda.
Bir WebBrowser var forumda.
Formun UserForm_Layout olay&#305; ile daha &#246;nce olu&#351;turulmu&#351; ise orjinalgabari1.dwg dosyas&#305;n&#305; bu WebBrowserd'a g&#246;steriyor, yoksa bo&#351; geliyor.
Gabari &#231;iz d&#252;&#287;mesine t&#305;klad&#305;&#287;&#305;n&#305;zda ilk &#246;nce orjinalgabari1.dwg dosyas&#305; yoksa bu dosyay&#305; olu&#351;turuyor, listeden se&#231;ti&#287;iniz se&#231;ene&#287;e g&#246;re gabariyi olu&#351;turuyor. Daha sonra formun &#252;zerindeki bilgilere g&#246;re bir &#351;ekil olu&#351;turuyor. Burada ama&#231; olu&#351;turulan &#351;eklin gbari i&#231;inde kal&#305;p kalmad&#305;&#287;&#305;n&#305; kontol etmek.

 

[Biolight]

Excel2AutoCAD- Dikdörtgen

Merhaba,

Excel den AutoCAD e çizim yapırmak için
önceden bir arkadaşa küçük bir örnek yapmıştım
tam sizin istediğiniz gibi Dikdörtgen çiziyor
Kodlarda açıklamalarda mevcud.

sadece A ve B ile belirtilen hücreleri doldurunuz.
sonra Dikdörtgen çiz tıklayınız.

Not:
AutoCAD 2007 harici versiyon kullanıyorsanız

VBE(kodların olduğu sayfa) penceresinde
Tools - References tıklayıp
AutoCAD 2007 Type Library iptal edip
Kullandığınız AutoCAD versiyonunu onaylayınız

Kolay gelsin.

Değişiklik : Ekte ki dosya yeniden yüklendi.

 

[elmali123]

Dosyaların hiçbirini indiremiyorum ... Güncellemeniz mümkün mü ?