[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 AcadModelSpace  Sub 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 Range  On 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==

[XLS-SVY-006]:Menghitung Luas Cross Section dengan Visual Basic Application Excel (Macro)

Referensi	:	http://cadex.wordpress.com/2010/12/05/xls-svy-004membuat-grafik-dan-menghitung-luas-cross-section-dengan-excel-bagian-2/
Platform	:	Excel
File	:

Pada post [XLS-SVY-004]:Membuat Grafik dan Menghitung Luas Cross Section dengan Excel Bagian #2, telah diuraikan tahapan menghitung luas cross section dengan menggunakan rumus / fungsi excel (tanpa macro). Pada hitungan metode ini, untuk mengurasi panjangnya rumus diperlukan beberapa cell bantu. Penggunakaan cell bantu tentunya akan memperbesar ukuran file excel, apalagi kalo data yang akan diolah terdiri dari beberapa station.

Dengan visual basic application, cell bantu tersebut dapat dihilangkan, sehingga didapat fungsi baru (user defined function/UDF) yang lebih simple.

Download file xs.xla dan file contoh cross section. Setelah didownload buka file xs.xla, kemudian file contoh cross sectionnya.

Contoh cross section :

Dalam file xs.xla ada dua UDF yaitu:

1. CatchPoint()

2. CutFillX()

1. Format Fungsi CatchPoint():

=CatchPoint(PolylineExisting ,OffsetTemplateKiri ,OffsetTemplateKanan,ElevasiTemplateKiri ,ElevasiTemplateKanan ,SlopeCatchPointKiri ,SlopeCatchPointKanan ) Fungsi ini akan menghasilkan 4 (empat) angka yaitu Offset, Elevasi catch point Kiri dan Offset Elevasi catch point kanan.

[B11]=Index(CatchPoint($Q$7:$R$57,$B$7,$C$7,$B$9,$C$9,$B$10,$C$10),1)

[B12]=Index(CatchPoint($Q$7:$R$57,$B$7,$C$7,$B$9,$C$9,$B$10,$C$10),2)

[C11]=Index(CatchPoint($Q$7:$R$57,$B$7,$C$7,$B$9,$C$9,$B$10,$C$10),3)

[C12]=Index(CatchPoint($Q$7:$R$57,$B$7,$C$7,$B$9,$C$9,$B$10,$C$10),4)

2. Format Fungsi CutFillX():

=CutFillX(PolylineExisting, PolylineDesign, TypeRtn)

TypeRtn=0, untuk menampilkan hasil hitungan luas Cut dan Fill. Gunakan index=1, untuk mengambil luas Cut, dan index=2 untuk mengambil lus Fill.

[G8]=INDEX(cutfillx($Q$7:$R$57,$S$7:$T$11,0),1)

[H8]=INDEX(cutfillx($Q$7:$R$57,$S$7:$T$11,0),2)

Coba rubah-rubah parameter design di seperti elevasi design, slope, grade, offset template dll, maka otomatis luas cross section dan grafik akan terupdate

Jika grafik terlihat seperti ini,

Rubah nilai cut/fill slope menjadi negatif atau sebaliknya di [B10] dan atau [C10], sehingga bentuk grafiknya menjadi:

‘============== selamat mencoba =========================