<?xml version="1.0" encoding="UTF-8"?>
<rss xmlns:content="http://purl.org/rss/1.0/modules/content/" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:taxo="http://purl.org/rss/1.0/modules/taxonomy/" version="2.0">
  <channel>
    <title>tema Re: In the Sub Procedure Inserting Drawings in Open AutoCAD File en AutoCAD Forum</title>
    <link>https://forums.autodesk.com/t5/autocad-forum/in-the-sub-procedure-inserting-drawings-in-open-autocad-file/m-p/7091566#M880077</link>
    <description>&lt;P&gt;The Problem is Solved, Thanks..&lt;/P&gt;</description>
    <pubDate>Thu, 18 May 2017 00:55:16 GMT</pubDate>
    <dc:creator>Anonymous</dc:creator>
    <dc:date>2017-05-18T00:55:16Z</dc:date>
    <item>
      <title>In the Sub Procedure Inserting Drawings in Open AutoCAD File</title>
      <link>https://forums.autodesk.com/t5/autocad-forum/in-the-sub-procedure-inserting-drawings-in-open-autocad-file/m-p/7078356#M879161</link>
      <description>&lt;PRE&gt;Sub Form_13()
On Error GoTo Hata
Dim xkoordinat As Double
Dim ykoordinat As Double
Dim sonsatir As Long
Dim Answer As Integer
Dim i As Long
Dim satirno As String
Dim sksadedi As String
Dim trfsksadedi As String
Dim prfadedi As String
Dim trfadedi As String
Dim og_sg1_adedi As String
Dim og_sg2_adedi As String
Dim sks1karakteristik As String
Dim trfskskarakteristik As String
Dim sts As Long
Dim txt As String
Dim txt2 As String
Dim txt3 As String
Dim konum As String
Dim topraklamafilizsayisi As Double
Dim direktopraklamahattiuzunlugu As Double
Dim topraklamaaskiuzunlugu As Double
Dim cizimalanix As Double
Dim cizimalaniy As Double
Dim demirdireksembolugenisligi As Double
Dim demirdireksemboluuzunlugu As Double
Dim tepeyeuzaklik As Double

'***********AUTOCAD AÇILIŞ*********************

Dim Cad As AutoCAD.AcadApplication
Set Cad = New AutoCAD.AcadApplication
Cad.Visible = True
Cad.Application.WindowState = acMax

Cad.ActiveDocument.SendCommand "lwdisplay on " ' &amp;amp; (Chr(27) &amp;amp; Chr(27)) 'Çizgi Kalınlıklarını göster

yol = "d:/form13.dwg"
Cad.ActiveDocument.SendCommand "HPNAME " &amp;amp; "SOLID" &amp;amp; vbCr 'Hatch için hazırlık, SOLID stilini seçer.

'sks1 = ""
'sks2 = ""
sts = 0
satirno = 0
sksadedi = 0
trfsksadedi = 0
prfadedi = 0
trfadedi = 0
og_sg1_adedi = 0
og_sg2_adedi = 0
brs_sks_yeni = 0
hatsonu_sks = 0
hatbasi_sks = 0
trafo_diregi = ""
hatbasi_sks_diregi = ""
sks1karakteristik = ""
trfskskarakteristik = ""
brs_trf_diregi_mi = 0

kagitbaskipayi = 10.1
cizimalanix = 199.9 '210 - kagitbaskipayi
cizimalaniy = 286.9 '297 - kagitbaskipayi
demirdireksemboluuzunlugu = 5
demirdireksembolugenisligi = 5
tepeyeuzaklik = 40
br_hat_uzunlugu = 25.5
direktopraklamahattiuzunlugu = 5
topraklamaaskiuzunlugu = 5
topraklamafilizuzunlugu = 2.5
topraklamafilizsayisi = 5

    
Cad.ActiveDocument.SendCommand "Rectang 0,0 " &amp;amp; Replace(cizimalanix, ",", ".") &amp;amp; "," &amp;amp; Replace(cizimalaniy, ",", ".") &amp;amp; " " 'Dış Çerçeve, Yazdırma Bölgesi Alanı
Cad.ActiveDocument.SendCommand "Zoom Extents" &amp;amp; vbCr &amp;amp; vbCr

x = Replace((cizimalanix / 2), ",", ".") '99.95
x1 = Replace((cizimalanix / 2) - (demirdireksembolugenisligi / 2), ",", ".") 'x-2.5=97.45
x2 = Replace((cizimalanix / 2) + (demirdireksembolugenisligi / 2), ",", ".") 'x+2.5=102.45
y = Replace(cizimalaniy - tepeyeuzaklik, ",", ".") '246.9
y1 = Replace(cizimalaniy - tepeyeuzaklik - (demirdireksemboluuzunlugu / 2), ",", ".") 'y-2.5=244.4
y2 = Replace(cizimalaniy - tepeyeuzaklik + (demirdireksemboluuzunlugu / 2), ",", ".") 'y+2.5=249.4

br1_x1 = Replace((cizimalanix / 2) - (demirdireksembolugenisligi / 2) - br_hat_uzunlugu, ",", ".") 'x1-25.5=71.95
br1_x2 = Replace((cizimalanix / 2) - (demirdireksembolugenisligi / 4), ",", ".") 'x-1.25=98.7
br2_x2 = Replace((cizimalanix / 2) + (demirdireksembolugenisligi / 2) + br_hat_uzunlugu, ",", ".") 'x2+25.5=127.95
br2_x1 = Replace((cizimalanix / 2) + (demirdireksembolugenisligi / 4), ",", ".") 'x+1.25=101.2

        Cad.ActiveDocument.SendCommand "Line " &amp;amp; br1_x1 &amp;amp; "," &amp;amp; y &amp;amp; ",0 " &amp;amp; x1 &amp;amp; "," &amp;amp; y &amp;amp; ",0 " &amp;amp; " " 'Branşman Hattı-Sol
        Cad.ActiveDocument.SendCommand "Line " &amp;amp; x2 &amp;amp; "," &amp;amp; y &amp;amp; ",0 " &amp;amp; br2_x2 &amp;amp; "," &amp;amp; y &amp;amp; ",0 " &amp;amp; " " 'Branşman Hattı-Sağ

        Cad.ActiveDocument.SendCommand "Rectang " &amp;amp; x1 &amp;amp; "," &amp;amp; y1 &amp;amp; " " &amp;amp; x2 &amp;amp; "," &amp;amp; y2 &amp;amp; " " 'Branşman Direği Sembolü Karesi (5x5)
    
    '*****BRANŞMAN DİREĞİ SEMBOLÜ ÇAPRAZLARI*****
            Cad.ActiveDocument.SendCommand "Line " &amp;amp; x1 &amp;amp; "," &amp;amp; y2 &amp;amp; ",0 " &amp;amp; x2 &amp;amp; "," &amp;amp; y1 &amp;amp; ",0 " &amp;amp; " "
            Cad.ActiveDocument.SendCommand "Line " &amp;amp; x1 &amp;amp; "," &amp;amp; y1 &amp;amp; ",0 " &amp;amp; x2 &amp;amp; "," &amp;amp; y2 &amp;amp; ",0 " &amp;amp; " "
    '********************************************
Cad.ActiveDocument.SendCommand ("-mtext" + vbCr &amp;amp; "54" &amp;amp; "," &amp;amp; "266.9" &amp;amp; vbCr + "j" + vbCr + "bl" + vbCr + "h" + vbCr + "5" + vbCr + "w" + vbCr + "91.9" + vbCr + "PRİMER MALZEME LİSTESİ" + vbCr + vbCr) 'Ana Başlık
Cad.ActiveDocument.SendCommand ("-mtext" + vbCr &amp;amp; "97" &amp;amp; "," &amp;amp; "251" &amp;amp; vbCr + "j" + vbCr + "br" + vbCr + "h" + vbCr + "2.5" + vbCr + "w" + vbCr + "20" + vbCr + "BR. " &amp;amp; "N-12" + vbCr + vbCr) 'Branşman Direği Tipi
    
    
''*****BRANŞMAN DİREĞİ TOPRAKLAMASI*****
    xkoordinat = 10245 / 100 'x2
    ykoordinat = 24940 / 100 'y2
direktopraklamahattiuzunlugux = Replace((direktopraklamahattiuzunlugu / 2) * Sqr(2), ",", ".") '3.54
direktopraklamahattiuzunluguy = Replace((direktopraklamahattiuzunlugu / 2) * Sqr(2), ",", ".") '3.54
brsdirektopr_trfdiregipayix = Replace(demirdireksembolugenisligi / 3, ",", ".") '~1.67
brsdirektopr_trfdiregipayiy = Replace(demirdireksemboluuzunlugu / 3, ",", ".") '~1.67
xt1 = Replace((cizimalanix / 2) + (demirdireksembolugenisligi / 2) - (demirdireksembolugenisligi / 3), ",", ".") 'xt1 = x2-1.67=100.78
yt1 = Replace(cizimalaniy - tepeyeuzaklik + (demirdireksemboluuzunlugu / 2) - (demirdireksemboluuzunlugu / 3), ",", ".") 'yt1 = y2-1.67=247.73
xt2 = Replace((cizimalanix / 2) + (demirdireksembolugenisligi / 2) + (direktopraklamahattiuzunlugu / 2) * Sqr(2), ",", ".") 'xt1 = x2+3.54=105.99
yt2 = Replace(cizimalaniy - tepeyeuzaklik + (demirdireksemboluuzunlugu / 2) + (direktopraklamahattiuzunlugu / 2) * Sqr(2), ",", ".") 'yt1 = y2+3.54=252.94

        Cad.ActiveDocument.SendCommand "Line " &amp;amp; xt1 &amp;amp; "," &amp;amp; yt1 &amp;amp; ",0 " &amp;amp; xt2 &amp;amp; "," &amp;amp; yt2 &amp;amp; ",0 " &amp;amp; " "


    xt1 = Replace((((direktopraklamahattiuzunlugu - (((topraklamafilizsayisi - 1) / 2) * (topraklamaaskiuzunlugu / (topraklamafilizsayisi - 1)))) / 2)) * Sqr(2) + ((cizimalanix / 2) + (demirdireksembolugenisligi / 2)), ",", ".")
    yt1 = Replace((((direktopraklamahattiuzunlugu - (((1 - topraklamafilizsayisi) / 2) * (topraklamaaskiuzunlugu / (topraklamafilizsayisi - 1)))) / 2)) * Sqr(2) + (cizimalaniy - tepeyeuzaklik + (demirdireksemboluuzunlugu / 2)), ",", ".")
    xt2 = Replace((((direktopraklamahattiuzunlugu - (((1 - topraklamafilizsayisi) / 2) * (topraklamaaskiuzunlugu / (topraklamafilizsayisi - 1)))) / 2)) * Sqr(2) + ((cizimalanix / 2) + (demirdireksembolugenisligi / 2)), ",", ".")
    yt2 = Replace((((direktopraklamahattiuzunlugu - (((topraklamafilizsayisi - 1) / 2) * (topraklamaaskiuzunlugu / (topraklamafilizsayisi - 1)))) / 2)) * Sqr(2) + (cizimalaniy - tepeyeuzaklik + (demirdireksemboluuzunlugu / 2)), ",", ".")
    
    Cad.ActiveDocument.SendCommand "Line " &amp;amp; xt1 &amp;amp; "," &amp;amp; yt1 &amp;amp; ",0 " &amp;amp; xt2 &amp;amp; "," &amp;amp; yt2 &amp;amp; ",0 " &amp;amp; " "


'********************* bu kısım iyi düşünülmeli **************************
'********************* SEKSİYONER BRANŞMAN DİREĞİNDEYSE ******************
    Cad.ActiveDocument.SendCommand "Line 102.45,244.4,0 104.5713,242.2787,0 " &amp;amp; " "
    Cad.ActiveDocument.SendCommand "Arc 104.57132,238.743146 104.57132,242.27868 108.106854,242.27868 " &amp;amp; " " 'Hat Başı Seksiyoner Yay Simgesi
    Cad.ActiveDocument.SendCommand "Line 111.2888,235.5612,0 104.5289,237.3714,0 " &amp;amp; " "

    Cad.ActiveDocument.SendCommand "Line 106.8623,238.432,0 107.8382,234.8116,0 " &amp;amp; " "
    Cad.ActiveDocument.SendCommand "Line 107.421,238.2835,0 108.3897,234.6561,0 " &amp;amp; " "
    Cad.ActiveDocument.SendCommand "Line 107.9796,238.1209,0 108.9554,234.5005,0 " &amp;amp; " "

    Cad.ActiveDocument.SendCommand "Line 114.8244,232.0256,0 111.2888,235.5612,0 " &amp;amp; " "
    Cad.ActiveDocument.SendCommand "Line 115.7083,232.9095,0 113.9405,231.1417,0 " &amp;amp; " "
    
    Cad.ActiveDocument.SendCommand "Rectang 114.647592,230.434641 121.647592,232.934641 "
    Cad.ActiveDocument.SendCommand "Select Last" &amp;amp; " " &amp;amp; " "
    Cad.ActiveDocument.SendCommand "Rotate 114.647592,230.434641 315" &amp;amp; " " &amp;amp; " "

    Cad.ActiveDocument.SendCommand "Line 118.1831,231.1417,0 115.7083,228.6669,0 " &amp;amp; " "
    Cad.ActiveDocument.SendCommand "Line 119.2438,230.0811,0 116.7689,227.6062,0 " &amp;amp; " "
    Cad.ActiveDocument.SendCommand "Line 120.3044,229.0204,0 117.8296,226.5456,0 " &amp;amp; " "

    Cad.ActiveDocument.SendCommand "Line 122.0722,226.5456,0 120.3044,224.7778,0 " &amp;amp; " "
'*************************************************************************
'*************************************************************************

Cad.ActiveDocument.SendCommand "Zoom Extents" &amp;amp; vbCr &amp;amp; vbCr
Cad.Application.ActiveDocument.SaveAs "d:/form13.dwg"

Set Cad = Nothing

Call direktopraklama_ciz(topraklamafilizsayisi, direktopraklamahattiuzunlugu, topraklamaaskiuzunlugu, demirdireksembolugenisligi, demirdireksemboluuzunlugu, tepeyeuzaklik)
Hata:

Exit Sub
End Sub
Sub direktopraklama_ciz(topraklamafilizsayisi1 As Double, direktopraklamahattiuzunlugu1 As Double, topraklamaaskiuzunlugu1 As Double, demirdireksembolugenisligi1 As Double, demirdireksemboluuzunlugu1 As Double, tepeyeuzaklik1 As Double)

    Dim acadApp                         As AcadApplication
    Dim ThisDrawing                     As AcadDocument
    Dim i                               As Long
    Dim j                               As Long
    Dim topraklamafilizuzunlugu1        As Double: topraklamafilizuzunlugu1 = 2.5
    Dim cizimalanix1                    As Double: cizimalanix1 = 199.9
    Dim cizimalaniy1                    As Double: cizimalaniy1 = 286.9

    Dim xt11                            As String
    Dim yt11                            As String
    Dim xt22                            As String
    Dim yt22                            As String

    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
    If acadApp Is Nothing Then
        Set acadApp = New AcadApplication
        acadApp.Visible = True
    End If
    Set ThisDrawing = acadApp.ActiveDocument
    
    
    Set acadApp = GetObject(, "AutoCAD.Application")
    acadApp.Documents.Open "d:/form13.dwg", , True
    acadApp.Visible = True
               
    i = (topraklamafilizsayisi1 - 1)
Do While i &amp;gt;= ((1 - topraklamafilizsayisi1))
    j = -1 * i
    xt11 = Replace((((direktopraklamahattiuzunlugu1 - ((i / 2) * (topraklamaaskiuzunlugu1 / (topraklamafilizsayisi1 - 1)))) / 2)) * Sqr(2) + ((cizimalanix1 / 2) + (demirdireksembolugenisligi1 / 2)), ",", ".")
    yt11 = Replace((((direktopraklamahattiuzunlugu1 - ((j / 2) * (topraklamaaskiuzunlugu1 / (topraklamafilizsayisi1 - 1)))) / 2)) * Sqr(2) + (cizimalaniy1 - tepeyeuzaklik1 + (demirdireksemboluuzunlugu1 / 2)), ",", ".")
    xt22 = Replace((((topraklamafilizuzunlugu1 + direktopraklamahattiuzunlugu1 - ((i / 2) * (topraklamaaskiuzunlugu1 / (topraklamafilizsayisi1 - 1)))) / 2)) * Sqr(2) + ((cizimalanix1 / 2) + (demirdireksembolugenisligi1 / 2)), ",", ".")
    yt22 = Replace((((topraklamafilizuzunlugu1 + direktopraklamahattiuzunlugu1 - ((j / 2) * (topraklamaaskiuzunlugu1 / (topraklamafilizsayisi1 - 1)))) / 2)) * Sqr(2) + (cizimalaniy1 - tepeyeuzaklik1 + (demirdireksemboluuzunlugu1 / 2)), ",", ".")
        acadApp.ActiveDocument.SendCommand "Line " &amp;amp; xt11 &amp;amp; "," &amp;amp; yt11 &amp;amp; ",0 " &amp;amp; xt22 &amp;amp; "," &amp;amp; yt22 &amp;amp; ",0 " &amp;amp; " "
    i = i - 2
Loop


    acadApp.ZoomExtents

    Set acadDoc = Nothing
    Set acadApp = Nothing
    
End Sub&lt;/PRE&gt;&lt;P&gt;&lt;SPAN&gt;Hello to everyone,&lt;BR /&gt;&lt;BR /&gt;&lt;SPAN&gt;I have been doing programs with Excel, VBA, AutoCAD triple for a long time.&lt;/SPAN&gt; &lt;SPAN&gt;Lazy codes were too long, and the projects were very complex, and it was inevitable to get a "Procedure too Large" error.&lt;/SPAN&gt; &lt;SPAN&gt;I also had to divide the current drawing programs.&lt;/SPAN&gt; &lt;SPAN&gt;Now I have a new problem.&lt;/SPAN&gt;&lt;BR /&gt;&lt;BR /&gt;&lt;SPAN&gt;When I run the above code in Excel, the macro named myProtection_Ciz works;&lt;/SPAN&gt; &lt;SPAN&gt;A new drawing is added to the already open drawing file.&lt;/SPAN&gt; &lt;SPAN&gt;But it does not open the file for the second time.&lt;/SPAN&gt; &lt;SPAN&gt;When I try to open the file in the first mode and open it in the second mode, I can not save the file because it is read-only.&lt;/SPAN&gt;&lt;BR /&gt;&lt;BR /&gt;&lt;SPAN&gt;I need your ideas and suggestions that are very valuable to me.&lt;/SPAN&gt; &lt;SPAN&gt;What should be done to work with the above codes?&lt;/SPAN&gt; &lt;SPAN&gt;Please help me..&lt;/SPAN&gt;&lt;/SPAN&gt;&lt;/P&gt;</description>
      <pubDate>Thu, 11 May 2017 19:17:41 GMT</pubDate>
      <guid>https://forums.autodesk.com/t5/autocad-forum/in-the-sub-procedure-inserting-drawings-in-open-autocad-file/m-p/7078356#M879161</guid>
      <dc:creator>Anonymous</dc:creator>
      <dc:date>2017-05-11T19:17:41Z</dc:date>
    </item>
    <item>
      <title>Re: In the Sub Procedure Inserting Drawings in Open AutoCAD File</title>
      <link>https://forums.autodesk.com/t5/autocad-forum/in-the-sub-procedure-inserting-drawings-in-open-autocad-file/m-p/7091566#M880077</link>
      <description>&lt;P&gt;The Problem is Solved, Thanks..&lt;/P&gt;</description>
      <pubDate>Thu, 18 May 2017 00:55:16 GMT</pubDate>
      <guid>https://forums.autodesk.com/t5/autocad-forum/in-the-sub-procedure-inserting-drawings-in-open-autocad-file/m-p/7091566#M880077</guid>
      <dc:creator>Anonymous</dc:creator>
      <dc:date>2017-05-18T00:55:16Z</dc:date>
    </item>
  </channel>
</rss>

