Koordinat sistemi ile AutoCad'e çizim kodları hata veriyor

[cocoa35]

Merhaba aşağıdaki kodlar ile şu ana kadar Koordinat sistemi Excel'den AutoCad'e çizim yaptırıyordum ancak şimdi hata vermeye başladı kod'lardaki hata veren kısmı sarı renk ile boyadım sorun nedir acaba?

Sub KoordinatCizimi()

Dim koordinat
Dim xkoordinat
Dim ykoordinat


Dim Secim As Range

Set Secim = Application.InputBox(Prompt:="İLK(X)Koordinatı Fare ile seçiniz. ÖRNEK: $A$2 veya A2" & vbCrLf & _
vbCrLf & "* Y koordinatı Belirlediniz (X)hücrenin yanındaki Sütun olacaktır" & vbCrLf & _
"* Z koordinatı Sıfır(0) kabul edilecektir.", Title:="İlk X Koordinatını Seçiniz", Type:=8)

Range(Secim.Address(False, False)).Select

Application.ScreenUpdating = False


Do While Not IsEmpty(ActiveCell)

xkoordinat = Replace(ActiveCell.Value, ",", ".")
koordinat = koordinat & xkoordinat & ","

ActiveCell.Offset(0, 1).Activate

ykoordinat = Replace(ActiveCell.Value, ",", ".")
If ykoordinat = "" Then
ykoordinat = 0
End If

koordinat = koordinat & ykoordinat & ",0 "
ActiveCell.Offset(1, -1).Activate
Loop

Range(Secim.Address(False, False)).Select

Application.ScreenUpdating = True

Dim Cad As Object

Set Cad = CreateObject("AutoCad.Application")

Cad.Application.ActiveDocument.SaveAs ActiveWorkbook.Path & "/" & _
Replace(ActiveWorkbook.Name, ".xlsm", ".dwg")

Cad.Visible = True

Cad.ActiveDocument.SendCommand "Line " & koordinat & " "


Cad.ActiveDocument.SendCommand "Zoom Extents "

Cad.Application.ActiveDocument.Save

Set Cad = Nothing

Exit Sub

End Sub

 

[muhasebeciyiz]

Merhaba! Verdiğiniz hata, Set Cad = CreateObject("AutoCad.Application") satırında çıkıyor ve bu hata, AutoCAD uygulamasının VBA tarafından düzgün şekilde başlatılamadığını gösteriyor.

AutoCAD'in kurulu olduğu dizine gidin.
acad.exe veya acadLT.exe'yi sağ tıklayın ve "Yönetici olarak çalıştır" seçeneğini seçin.
Eğer güvenlik ayarları veya grup ilkeleri nedeniyle COM nesnelerine erişim engellenmişse, VBA'nın AutoCAD ile iletişim kurması mümkün olmayabilir.

Eğer AutoCAD zaten açıksa, aşağıdaki kodla mevcut aktif AutoCAD uygulamasına bağlanmayı deneyebilirsiniz:

On Error Resume Next
Set Cad = GetObject(, "AutoCAD.Application")
If Cad Is Nothing Then
Set Cad = CreateObject("AutoCAD.Application")
End If
On Error GoTo 0

Hata, genellikle AutoCAD ile VBA arasındaki iletişimde bir sorun olduğunu gösterir. AutoCAD'in doğru şekilde yüklü ve VBA desteğinin açık olduğundan emin olduktan sonra, bu tür hatalar büyük ölçüde giderilebilir.

 

[Biolightant]

Merhaba,
@muhasebeciyiz söylediklerine ek olarak

VBA Editör menu > Tools > References... > AutoCAD 2013 Type Library Seçili konumda olmalı
( sizde AutoCAD kaç yüklüyse 2013 yerine o versiyon yılı olması gerek )

VBA kodlarda bir iki problem vardı yeniden düzenledim.

Sub KoordinatCizimi()
    Dim koordinat As String
    Dim xkoordinat As String, ykoordinat As String
    Dim Secim As Range
    Dim Cad As Object

    ' Koordinat Seçimi
    On Error Resume Next
    Set Secim = Application.InputBox(Prompt:="İLK(X)Koordinatı Fare ile seçiniz. ÖRNEK: $A$2 veya A2" & vbCrLf & _
    vbCrLf & "* Y koordinatı Belirlediniz (X)hücrenin yanındaki Sütun olacaktır" & vbCrLf & _
    "* Z koordinatı Sıfır(0) kabul edilecektir.", Title:="İlk X Koordinatını Seçiniz", Type:=8)
    On Error GoTo 0

    ' Seçim yapılmadıysa işlemi sonlandır
    If Secim Is Nothing Then
        MsgBox "Seçim yapılmadı, işlem iptal edildi.", vbInformation, "İptal edildi..."
        Exit Sub
    End If

    Application.ScreenUpdating = False

    Do While Not IsEmpty(Secim)
        xkoordinat = Replace(Secim.Value, ",", ".")
        ykoordinat = Replace(Secim.Offset(0, 1).Value, ",", ".")
        If ykoordinat = "" Then ykoordinat = 0
        koordinat = koordinat & xkoordinat & "," & ykoordinat & ",0 "
        Set Secim = Secim.Offset(1, 0)
    Loop

    Application.ScreenUpdating = True

    ' VBA Editör menu > Tools > References... > AutoCAD 2013 Type Library Seçili konumda olmalı
    ' AutoCAD Nesnesi Oluşturma (Late Binding)
    On Error Resume Next
    Set Cad = GetObject(, "AutoCAD.Application")
    If Cad Is Nothing Then
        Set Cad = CreateObject("AutoCAD.Application")
    End If
    On Error GoTo 0
    
    If Cad Is Nothing Then
        MsgBox "AutoCAD başlatılamadı. Lütfen AutoCAD'in kurulu olduğunu ve düzgün çalıştığını kontrol edin.", vbCritical
        Exit Sub
    End If

    Cad.Visible = True

    ' DWG Kaydetme
    Cad.Application.ActiveDocument.SaveAs ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".xlsm", ".dwg")

    ' Çizim ve Yakınlaştırma
    Cad.ActiveDocument.SendCommand "LINE " & koordinat & vbCr
    Cad.ActiveDocument.SendCommand "ZOOM EXTENTS "

    ' Dosyayı Kaydetme
    Cad.Application.ActiveDocument.Save
    Set Cad = Nothing
End Sub