[XLS-SVY-007]: Plotting Cross Section dari Excel ke AutoCAD

Referensi	:	[XLS-MAP-03]: Plotting List Koordinat dari Excel ke AutoCAD
Platform	:	Excel dan AutoCAD
Lokasi File	:	xls-svy-007.zip

Rencananya program ini akan saya masukkan ke program perhitungan cut and fill cross section dengan vba/macro. Tetapi mempertimbangkan bahwa untuk melakukan koneksi excel ke autocad harus menggunakan library autocad yang sesuai dengan versi autocad yang sudah terinstall, maka code koneksi ini tidak saya masukkan.

Saat saya menulis program ini, saya menggunakan AutoCAD versi 2011. Versi autocad yang lain dan cara setting di Visual Basic Application, silahkan membaca [XLS-MAP-03]: Plotting List Koordinat dari Excel ke AutoCAD di section ‘Setting Reference ke AutoCAD Library’.

Code dalam visual basic application, saya bagi menjadi dua bagian yaitu Procedure Utama dan Procedure/Function Pendukung. Procedure Utama adalah nama macro yang akan dijalankan melalui menu excel, sedangkan procedure/function pendukung adalah procedure2 yang tidak ditampilkan dalam menu macro di excel.

Procedure Utama:

Option Explicit
Dim appCAD As AcadApplication
Dim acadDoc As AcadDocument
Dim acadMspace As AcadModelSpaceSub PlotGarisCrossSection()
Dim LstKoordExisting() As Double, LstKoordDesign() As Double
Dim BasePoint As Variant, OK As Boolean
OK = True
‘Membaca list koordinat existing dan design
If Not BacaListKoordinat(LstKoordExisting, “Pilih List Koordinat Existing “) Then Exit Sub
If Not BacaListKoordinat(LstKoordDesign, “Pilih List Koordinat Design “) Then Exit Sub
‘Jika bisa connect autocad, ganti window ke autocad
If ConnectAutoCAD = Not OK Then Exit Sub
GantiWindowKeCAD
BasePoint = GetPointInCAD(“Base Point”) ‘base point untuk menggambar cross section
‘Buat Layer dengan nama Existing
SetLayerAktif “Existing”
‘Plot Garis (Polyline) Existing di layer Existing
PlotGaris2D LstKoordExisting, CDbl(BasePoint(0)), CDbl(BasePoint(1))

‘Buat Layer dengan nama Design
SetLayerAktif “Design”
‘Plot Garis (Polyline) Design di layer Design
PlotGaris2D LstKoordDesign, CDbl(BasePoint(0)), CDbl(BasePoint(1))

‘plot label dengan jarak baris exiting =1, design =1, tinggi huruf=0.1
x_section_label CDbl(BasePoint(0)), CDbl(BasePoint(1)), 1, 1, 0.1
End Sub

Text warna biru adalah procedure atau function pendukung.

Procedure Pendukung (Private):

‘==private sub dan function====
‘=================
‘1. Objects Excel
‘=================
Private Function BacaListKoordinat(rtnListXY() As Double, ByVal strTitle As String) As Boolean
Dim aRange As Range, cr As RangeOn Error GoTo Err_Trap:
Set aRange = Application.InputBox(Prompt:=strTitle, Type:=8)
If aRange.Columns.Count < 2 And aRange.Columns.Count > 2 Then
MsgBox “List Koordinat Harus 2 (Dua) Kolom. Kolom Pertama X, Kolom Kedua Y ”
GoTo Err_Trap
End If

‘membaca koordinat x dan y, hasilnya disimpan di rtnListXY()
Dim i As Integer
i = -1
For Each cr In aRange.Columns(1).Cells
i = i + 2
ReDim Preserve rtnListXY(i)
rtnListXY(i – 1) = cr
rtnListXY(i) = cr.Offset(, 1)
Next
BacaListKoordinat = True
Exit Function
Err_Trap:
Err.Clear
BacaListKoordinat = False
End Function
‘==================
‘2. Objects AutoCAD
‘==================
Private Function ConnectAutoCAD() As Boolean
On Error Resume Next
ConnectAutoCAD = True
Set appCAD = GetObject(, “AutoCAD.Application”)
Set acadDoc = appCAD.ActiveDocument
Set acadMspace = acadDoc.ModelSpace
If Err.Number Then
ConnectAutoCAD = False
Exit Function
End If
End Function
Private Sub GantiWindowKeCAD()
AppActivate appCAD.Caption
End Sub

Private Function GetPointInCAD(strPrompt As String) As Variant
GetPointInCAD = acadDoc.Utility.GetPoint(, strPrompt)
End Function

Private Sub SetLayerAktif(strNamaLayer As String)
Dim aLayer As AcadLayer
On Error Resume Next
Set aLayer = acadDoc.Layers(strNamaLayer)
If Err.Number Then
Err.Clear
Set aLayer = acadDoc.Layers.Add(strNamaLayer)
End If
acadDoc.ActiveLayer = aLayer
End Sub

Private Sub PlotGaris2D(ListTitik() As Double, Optional Xorigin As Double = 0, Optional Yorigin As Double = 0)
Dim i As Integer
For i = LBound(ListTitik) To UBound(ListTitik) Step 2
ListTitik(i) = ListTitik(i) + Xorigin
ListTitik(i + 1) = ListTitik(i + 1) + Yorigin
Next i
acadMspace.AddLightWeightPolyline ListTitik
End Sub
Private Function GetOneEntity(ByVal strPrompt As String) As AcadEntity
Dim objEntity As AcadObject, PickedPoint(0 To 2) As Double
AppActivate appCAD.Caption
acadDoc.Utility.GetEntity objEntity, PickedPoint, strPrompt
Set GetOneEntity = objEntity
End Function
Private Sub x_section_label(Xorigin As Double, Yorigin As Double, _
TinggiBaris1 As Double, TinggiBaris2 As Double, TinggiHuruf As Double)

Dim anEntity As AcadEntity, polyExisting As AcadLWPolyline, polyDesign As AcadLWPolyline
Dim aText As AcadText

Dim i As Integer, stLine(0 To 2) As Double, edLine(0 To 2) As Double, Xmin As Double, Xmax As Double
Dim Existing_XY() As Double, Design_XY() As Double, Ymin As Double
Dim pntText(0 To 2) As Double, textRotation As Double

textRotation = Application.Radians(90)
Ymin = Yorigin – TinggiBaris1 – TinggiBaris2
Set anEntity = GetOneEntity(“Pilih Polyline Existing”)
If anEntity.ObjectName = “AcDbPolyline” Then
Set polyExisting = anEntity
Existing_XY = polyExisting.Coordinates
Xmin = Existing_XY(0)
‘gambar garis vertikal
SetLayerAktif “Grid Existing”
For i = LBound(Existing_XY) To UBound(Existing_XY) Step 2
stLine(0) = Existing_XY(i)
stLine(1) = Existing_XY(i + 1)
Xmax = stLine(0)
edLine(0) = stLine(0)
edLine(1) = Ymin
acadMspace.AddLine stLine, edLine

‘menulis text elevasi dan jarak
pntText(1) = Yorigin – TinggiBaris1
‘Label jarak
pntText(0) = stLine(0) – TinggiHuruf
Set aText = acadMspace.AddText(Format(stLine(0) – Xorigin, “0.00”), pntText, TinggiHuruf)
aText.Rotate pntText, textRotation
‘Label elevasi
pntText(0) = stLine(0) + TinggiHuruf
Set aText = acadMspace.AddText(Format(stLine(1) – Yorigin, “0.00”), pntText, TinggiHuruf)
aText.Rotate pntText, textRotation

Next i
End If

‘Gambar Garis Base Line
SetLayerAktif “Datum”
stLine(0) = Xmin: edLine(0) = Xmax
stLine(1) = Yorigin: edLine(1) = stLine(1)
acadMspace.AddLine stLine, edLine

stLine(0) = Xmin: edLine(0) = Xmax
stLine(1) = Yorigin – TinggiBaris1: edLine(1) = stLine(1)
acadMspace.AddLine stLine, edLine

stLine(0) = Xmin: edLine(0) = Xmax
stLine(1) = Yorigin – TinggiBaris1 – TinggiBaris2: edLine(1) = stLine(1)
acadMspace.AddLine stLine, edLine

Set anEntity = GetOneEntity(“Pilih Polyline Design”)
If anEntity.ObjectName = “AcDbPolyline” Then
Set polyDesign = anEntity
Design_XY = polyDesign.Coordinates

‘menggambar garis vertikal di layer grid design
SetLayerAktif “Grid Design”
For i = LBound(Design_XY) To UBound(Design_XY) Step 2
stLine(0) = Design_XY(i)
stLine(1) = Design_XY(i + 1)

edLine(0) = stLine(0)
edLine(1) = Ymin
acadMspace.AddLine stLine, edLine

‘menulis text elevasi dan jarak
pntText(1) = Yorigin – TinggiBaris1 – TinggiBaris2

‘Label jarak
pntText(0) = stLine(0) – TinggiHuruf
Set aText = acadMspace.AddText(Format(stLine(0) – Xorigin, “0.00”), pntText, TinggiHuruf)
aText.Rotate pntText, textRotation

‘Label elevasi
pntText(0) = stLine(0) + TinggiHuruf
Set aText = acadMspace.AddText(Format(stLine(1) – Yorigin, “0.00”), pntText, TinggiHuruf)
aText.Rotate pntText, textRotation

Next i
End If
End Sub

‘===end private sub dan function”

Download List Program (mdlPlot2CAD.bas)

Download contoh cross section (xls-svy-007.zip)

Menjalankan Makro

1. Buka Excel yang ada di file xls-svy-007.zip dan AutoCAD

2. Pada Program Excel tekan Alt+F11 untuk membuka Microsoft Visual Basic Editor

3. Di Microsoft Visual Basic Editor, tekan Ctr+M kemudian pilih file mdlPlot2CAD.bas yang sudah didownload.

4. Setting library ke AutoCAD yang ada di komputer Anda.

5. Keluar dari Microsoft Visual Basic Editor dengan menekan Alt+Q

6. Pada file xls-svy-007.xls, tekan Alt+F8 kemudian double click macro PlotGarisCrossSection

Gunakan Mouse untuk mengeblok koordinat (offset, elevasi) Existing yaitu $Q$7:$R$57, kemudian click OK. Akan muncul kotak dialog seperti di atas lagi, untuk memilih (mengeblok) koordinat design yaitu $S$7:$T$11. Akhiri dengan click OK

7. Pindah ke program AutoCAD, jika program tidak pindah ke AutoCAD secara otomatis.

8. Di Autocad akan muncul prompt

Command: Base Point >> Click sembarang lokasi di AutoCAD
Command: Pilih Polyline Existing >> Pilih Polyline Existing di AutoCAD
Command: Pilih Polyline Design >> Pilih Polyline Design di autoCAD

9. Lakukan setting warna Layer

10. Gambar cross section di AutoCAD, lengkap dengan label offset dan elevasi

selamat mencoba

==zainul==

36 thoughts on “[XLS-SVY-007]: Plotting Cross Section dari Excel ke AutoCAD”

thanks bgt boss
ilmunya

setelah double click macro PlotGarisCrossSection kok muncul error gan
gmn mengatasinya?

cadex says:

November 24, 2011 at 05:33

bisa kirim file excelnya dan informasi versi autocadnya ke zainul_ulum@yahoo.com

Reply

mas, bagaimna men-seting library pada poin 4 diatas? masih bingung nech … hehehe
ka kasih sebelumnya ya mas..

mas, maksud dari point 4 apa? “Setting library ke AutoCAD yang ada di komputer Anda”
ka ga ngerti saya, hehe. ma kasih sebelumnya ya!

weel says:

January 1, 2012 at 13:36

mas, pertanyaanku sudah terjawab kok mas, masalahnya muncul di point 8, pada cad memang muncul prompt diatas, gambarnya yang ga jadi, cuma menghasilkan dua point saja… ;(

Reply
1. cadex says:
  
  January 8, 2012 at 23:19
  
  apakah semua data sudah dipilih (block)?

mas, bagaimana cara menambahkan elevasix.. dengan kata lain kisa sdh setting elevasi rencanax..
untuk di munculkan scr otomatis.. mkasiih

cadex says:

May 25, 2012 at 20:24

program belum support untuk elevasi design atau rencana.

Reply

gan,,,
command : base point ( di klik sembarang sudah)
command : pilih polyline existing ( nie maksudnya gimana ya )
command : pilih polyline design ( nie maksudnya gimana ya )
tolong dibantu gan karena tidak muncul otomatis ditempat saya….

cadex says:

June 9, 2012 at 10:44

apakah format isian datanya sesuai dengan file contohnya? jika sudah seharusnya tergambar dua polyline existing dan design. apabila menu command: tidak muncul di autocad, cobat tekan Ctrl+9 di autocad untuk menampilkan menu atau prompt command:

Reply

mas…sy sdh ikuti semua langkah”nya n sebelumnya berhasil, tapi kali ini di file yg berbeda koq ga’ mau pindah otomatis ke autocad ya????tolong penjelasannya donk…..
(autocad saya 2011 n excel 2007)
trims so much before…. :)

cadex says:

June 20, 2012 at 15:32

coba program baru di
https://cadex.wordpress.com/2012/05/16/xls-svy-13-plotting-cross-section-dari-excel-ke-autocad-versi-1-0/

Reply

Assalamualaikum, bagaimana caranya saya merubah angka decimal daripada 2 decimal ke 3 decimal. Setelah saya cuba,
hasil text di autocad tetap 2 decimal. Saya telah mencuba versi terbaru namun saya gagal melakukan operasinya , jadi saya cuba
versi sebelumnya dan ia berhasil. Terima kasih.

wa’alaikum salam,
salam kenal. thanks for visiting my blog.

makasi buat ilmunya mas,, salam kenal…
mau nanya sedikit untuk tampilan cross section di autocad utk label elevasix bs dirubah ke arah sumbu Y gk..?
makasi…

mas..mau tanya…saya udh coba cara ini sampai langkah terakhir, tapi koq label offset dan elevasi serta layer” yg lain (kecuali layer existing) gak ada yang muncul di autocad(autocad yang saya pakai autocad 2011)…trims sebelumnya…

Cek apakah pemisah desimal di excel menggunakan “,” koma atau “.” titik? .Jika pemisah desimal adalah “,” koma rubah ke “.” titik

mas kenapa tabel offset ,ukuran dimensi dibawah cross section tidak muncul saat jalankan program

cadex says:

September 26, 2013 at 08:03

memang nggak muncul dimensi krn tidak terpogram. atau program yang saya buat tidak menampilkan dimensi yang dimaksud

Reply

yang memunculkan dimensi bisa gak mas dibuat programnya

cadex says:

October 14, 2013 at 08:43

memunculkan dimensi sangat tergantung dari client jadi tidak bisa dibuat secara general. sebetulnya dari label offset dan elevasi, bisa diketahui juga dimensinya. Sebenarnya dengan vba bisa juga dibuat programmnya tetapi terus terang saya belum pernah membuat….

Reply

mas kalau misalnya garis vertikalnya sy mau buat dengan skala tertentu gimana caranya?

cadex says:

December 21, 2013 at 06:07

silakan dicoba https://cadex.wordpress.com/2012/05/16/xls-svy-13-plotting-cross-section-dari-excel-ke-autocad-versi-1-0

Reply

Assallamu’alaikum Warrohmatullohi Wabarokatuh
Mas Zainul , di program mas di poin jarak itu kan akumulatif jarak yang terploting,
bagaimana caranya yang terploting itu jarak antar titiknya.
mohon bantuan dari mas zainul.
wassallam

cadex says:

June 2, 2014 at 10:31

Wa’alaikum salam Wr. Wb.
harus dirubah coding programnya Mas. Sampai saat ini belum sempat merubah…

Reply

Ass.. Mas Zainul, program mas Zainul bisa g dibuatkan langkah2nya dari awal memproses data ukur di excel sampai dengan memplotting ke autocad dalam bentuk buku panduan. nanti aku beli deh mas. tolong infonya. Aku sangat butuh program ini mas. aku tunggu infonya di email saya suryantopakiding@gmail.com
sukses selalu utk Mas Zainul…..

cadex says:

August 5, 2014 at 10:22

program yang saya buat ini dipakai untuk hasil pengukuran cross section metode jarak/offset dan elevasi. Alat yang dipakai bisa menggunakan total station atau waterpass.

Biasanya saat mengukur cross section pakai alat apa?

Reply