Author: cadex

[CAD-MAP-003]: Menghubungkan Excel Database ke Topology di Autocad Map Beserta dengan Query dan Anlisanya

Referensi	:	[CAD-MAP-001]: Menghitung Luas Bidang Tanah dengan Autocadmap
Platform	:	Excel dan Autocad Map
Download	:

Pada tulisan [CAD-MAP-001]: Menghitung Luas Bidang Tanah dengan Autocadmap telah diuraikan bagaimana cara menghitung luas bidang tanah dengan menggunakan fungsi polygon topology.

Sedangkan pada tulisan kali ini adalah proses lebih lanjut dengan menghubungkan polygon topologi tersebut dengan data attribute yang tersimpan dalam file spreadsheet excel. Saya menyarankan jika database dalam jumlah yang besar, data attribute sebaiknya disimpan dalam program yang memang dedicated untuk database seperti microsoft access, sql server, mysql atau program database lainnya.

Gambaran hubungan polygon topology dengan database adalah:

Kolom [txt_nib] pada speadsheet excel adalah modifikasi angka pada kolom [nib] menjadi format nib lima angka sehingga format nib di autocadmap akan sama dengan format nib di excel. Formula excel untuk merubah angka nib menjadi format huruf, gunakan formula atau fungsi excel = TEXT([nib],”00000″), jika angka [nib] di cell [B2], maka rumusnya menjadi =TEXT(B2,”00000″).

Jika Anda menggunakan Autocad 32 bit dan Excel 32 bit, pada tulisan [CAD-MAP-10]: Update Text dari Excel ke Autocad Map (Bagian #1) telah diuraikan bagaimana cara menghubungkan object text di autocadmap ke database excel. Langkah-langkah yang sama ternyata tidak bisa digunakan untuk windows system OS 64bit dengan excel 64 bit juga.

Saat saya menulis tutorial ini, saya sedang menggunakan Windows 10 Pro 64bit , Microsoft Excel 365 64 bit dan Autodesk Civil 3D 2016 juga 64 bit. Apabila Anda menggunakan versi windows, excel dan autocadmap yang lain bisa juga mengikuti tutorial ini dengan melakukan sedikit penyesuain.

Secara garis besar, tutorial terdiri dari:

1. Setting ODBC datasources.

2. Drawing Clean-up.

3. Membuat Polygon Topology.

4. Link Topology Polygon ke Excel.

5. Menulis Informasi dari Excel ke Autocad.

6. Export Data Attribute hasil linked database ke text file.

Berikut bahasan dari masing-masing langkah di atas:

1. Setting ODBC datasources.

Hasil googling, agar Autocad dapat membaca file database excel ber-extensi *.xlsx atau file database access *.acdb pada sistem 64 bit, maka perlu update database engine dengan terlebih dahulu download AccessDatabaseEngine_X64.exe kemudian diinstall untuk update database engine. Update database ini tidak diperlukan apabila menggunakan sistem 32bit.

Berikut cara setting ODBC Datasources:

Ketik ODBC pada [Search Windows], kemudian pilih [Set up ODBC Datasources (64-bit)]. Jika menggunakan OS 32-bit, pilih [Set up ODBC Datasources (32-bit)].

Pada kotak dialog [Microsoft ODBC Administrator], di page/halaman [User DSN], click tombol [Add]

Pada kotak dialog [Create New Data Source], pilih [Microsoft Excel Driver] kemudian click tombol [Finish]

Pada kotak dialog [ODBC Microsoft Excel Setup], lakukan setting misalnya seperti di bawah:

Click tombol [Select Workbook] untuk memilih file excel yang berisi data atribute bidang, kemudian click [Options] dan uncheck [Read Only]

click [OK] untuk menyimpan setting.

Catatan: setting ini dilakukan sekali saja jika database selalu terhubung ke file yang sama.

2. Drawing Clean-up.

Proses drawing clean-up digunakan untuk membersihkan object autocad sebelum dilakukan proses build topology. Detail bagaimana cara clean-up silakan dibaca di [CAD-MAP-001]: Menghitung Luas Bidang Tanah dengan Autocadmap. Pada tutorial ini hanya dibahas sekilas saja:

“Set layer on” / hidupkan layer hanya untuk garis batas polygon /bidang (layer: 020100) dan text nib (layer: 080201), kemudian bedakan warna layernya antara text nib dan batas polygon untuk mempermudah identifikasi.

Pada menu “Tool” di autocadmap, pilih [Drawing Clean Up]. Atau pada ketik di command: mapclean

Pada tahapan [Select Objects], pilih [Select All], kemudian click icon [Layer] untuk membatasi proses clean-up hanya untuk Layers: 020100, kemudian clicn [Next]

Pada tahapan [Clean Up Actions], set urutan action :

Break Crossing Object	Memutus garis yang saling bersilangan dengan menambahkan “titik” pada persimpangan garis
Delete Duplicates	Menghapus garis ganda hasil dari breaking crossing object
Erase Dangling Objects	Menghapus sisa garis yang tidak diperlukan biasanya garis sisa breaking yang ukuran panjangnya kecil
Dissolve Pseudo Nodes	Menghubungkan atau mirip perintah join pada pedit (polyline edit)

Click tombol [Next], untuk masuk ke tahap [Cleanup Methods]

Pada tahap [Cleanup Methos], pilih [Modify Original Object] kemudian check pilihan [Line to Polyline], [Arc to Polyline] dan [3D Polyline to Polyline]

Kemdian click tombol [Save] untuk menyimpan parameter drawing cleanup, sehingga untuk proses cleanup selanjutnya tinggal memanggil [Load] parameter tanpa harus setting lagi dari awal.

Click [Finish] untuk memulai proses drawing cleanup.

3. Membuat Polygon Topology

Jika workspace tool autocadmap belum aktif, aktfikan dengan mengetik di command: mapwspace

Pada task pane map, pilih toolspace [Map Exlporer], lalu click kanan [Topologies] kemudian pilih [Create]

Pada tahap [Topology Type], pilih topology type: [Polygon], kemudian beri nama misal topology name: blok01

click [Next] untuk masuk tahap berikutnya.

Pada tahap [Select Links], pilih [Select All], kemudain filter Layers hanya untuk batas polygon yaitu layer=02010

Lewati tahapan [Select Nodes] dan [Create New Nodes]

Click tahapan [Select Centroids], untuk menentukan bahwa pusat polygon atau id polygon adalah text nib.

Pada tahapan [Select Centroid], pilih [Select All], kemudain filter Layers hanya untuk text nib yaitu layer=080201

click [Finish] untuk memulai pembuatan topology.

Apabila proses pembuatan topology tidak berhasil atau keluar pesan kesalahan, lakukan editing geometry.

Jika berhasil, maka akan muncul nama topologynya di taskpane [Map Explorer] pada folder [Topologies]

untuk mengetahui informasi luas hasil topology, ketik di command: adeditdata

kemudian pilih text nib, sehingga dimunculkan informasi sebagai berikut:

Informasi luas (Area) hasil topology akan di hubungkan dengan informasi dalam tabel di excel.

4. Link Topology Polygon ke Excel.

Proses link ini dilakukan setelah setting ODBC datasources telah berhasil.

Lakukan checking tabel di excel yang akan di linked-kan khususnya range defined name pada spredsheet.

Buka file excel yang telah didefinisikan di datasource (Langkah-1) yaitu file: [pbt_attr.xlsx]

Pilih sheet atau tabel yang akan ditampilkan di autocad:

Block semua tabel termasuk dengan nama headernya, pada contoh data di atas dipilih/block range A1:F85, kemudian nama range tersebut di lokasi yang dilingkari merah sebagai “nik”. Nama ini akan muncul sebagai table di autocad map.

[Save] dan [Exit] dari file excel untuk kemudian dilakukan setting link template di autocadmap. Proses link tidak bisa dilakukan jika file data source masih terbuka.

Pada program autocad map, di task pane [Map Explorer], click kanan [Data Sources], kemudian pilih [Configure]

Isikan nama koneksi di Data Source Name, misal:odbc_xlsx_pbt, kemudian click [OK]

Pada page / halaman [Provider], pilih [Microsoft OLE DB Provider for ODBC Driver], kemudian click [Next]

Pada halaman [Connection], pilih [Use data source name] sesuai dengan definisi ODBC sebelumnya di langkah 1 yaitu: xlsx-pbt kemudian click [Test Connection].

jika connection berhasil, pilih halaman [Advanced]

Pada halaman [Advanced], set permission ke [ReadWrite], kemudian click OK.

Catatan: setting ini dilakukan sekali saja jika database selalu terhubung ke file yang sama.

Pada program autocad map, di task pane [Map Explorer], click kanan [Data Sources], kemudian pilih [Attach]

Pilih file udl yang telah disetting sebelumnya yaitu: odbc_xlsx_pbt

Pada task pane [Data Sources], sudah muncul tabel [nik] yang diambil dari excel. Double click table [nik] untuk melihat tabelnya.

Tabel diatas kemudian akan di linked kan dengan text nib di autocad dengan tool [Link Templates]

Pada taskpane [Map Explorer], click kanan [Link Templates], kemudian click [Define Link Template].

Masukkan nama link misal: lnk_nib, kemudian pilih kolom txt_nib sebagai Column Key.

Click kanan link template [lnk_nib] dalam folder [Link Templates], kemudian pilih [Generate Link]

Lakukan setting di [Generate Links] dengan linkage type: Text, Data Links: Create Database Links dengan Link Template: lnk_nib kemudian database validation: link must exist :

click [OK] kemudian pilih Select All untuk memulai proses link data attribute.

Cek hasil linked dengan memilih salah satu text nib di gambar, kemudian click kanan dan pilih [Properties]

contoh hasil property akan ada tambahan informasi hasil topology dan linked database:

Cara mengecek juga bisa dilakukan di data view table:

Pada folder [Link Templates], double click link template lnk_nib

Pada [Data View] pilih menu [Records] kemudian [Spatial Filter]

Pilih text nib di gambar, kemudian [Enter], maka Data View akan menampilkan table dengan record nib yang terpilih / record terfilter.

Jika selesai memilih, kembalikan ke mode non-filter dengan memilih menu [Records], kemudian pilih [Clear Filter]

5. Menulis Informasi dari Excel ke Autocad.

Object text telah ter-linked atau terkoneksi, pada tahap berikutnya kita coba tampilkan informasi dari database excel ke object text di autocad.

Informasi yang aka di tampilkan akan dibaut di layer terpisah karena sifatnya hanya informasi:

Informasi	Sumber Data	Layer
NIB	Linked Database	txt_nib
Nama	Linked Database	txt_nama
Luas	Topology	txt_luas

Buat layer-layer tersebut di autocad jika belum ada.

Pada task pane [Map Explorer], pilih folder [Topologies] kemudian click kanan topologi : [blok01] >> [Analysis] >> [Topology Query]

Pada kota dialog [Topology Query], click [Define Query]

Click tombol [Location], kemudian pilih [All]

Pada Query Mode, pilih [Draw]

Click tombol [Alter Properties]

Pada kotak dialog [Set Property Alterations], Click tombol [Text], kemudian pada kotak dialog [Define Text], click tombol [Expression]

Pilih, kolom TXT_NIB untuk mengambil text NIB dari linked template lnk_nib, kemudian click [OK] lalu set layer ke txt_nib di kotak dialog [Define Text]

Ulangi set [Text Value Expression] dengan memilih kolom PEMILIK daari linked template lnk_nib, kemudian click [OK] lalu set layer ke txt_nama di kotak dialog [Define Text]

Untuk informasi luas, pada [Text Value Expression] lakukan pilihan kolom Area dalam folder polygon cetroid di bawah grup topology poligon blok01

click [OK] kemudian lakukan setting layer ke txt_luas

agar informasi luas ditampilkan dalam bentuk angka bulan, rubah text expression menjadi : (STRCAT (RTOS :AREA@TPMCNTR_blok01 2 0) “M2”). Tampilan Set Property Alterations menjadi:

click [OK] kemudian click [Execute]

Tampilan gambar setelah query dan mematikan layer 080201:

Jika ingin menampilkan informasi koordinat di NIB, misal di layer txt_xy, tambahkan setting di text value expression dengan memilih kolom X1.Y1,Z1 di dalam folder [Properties]

Jika informasi koordinat ini tidak perlu dicetak atau ditampilkan, maka tinggal mematikan layer txt_xy

6. Export Data Attribute hasil linked database ke text file

Hasil linked gambar autocad dan database sudah bisa dilakukan. Selanjutnya adalah proses membuat report menjadi text file sehingga bisa dibuka di program excel atau program database.

Kolom atau informasi yang akan diexport adalah: Text nib, nama, luas, koordinat X dan koordinat Y.

Pada task pane [Map Explorer], pilih folder [Topologies] kemudian click kanan topologi : [blok01] >> [Analysis] >> [Topology Query]

Pada kota dialog [Topology Query], click [Define Query]

Click tombol [Location], kemudian pilih [All]

Pada Query Mode, pilih [Report], kemudian click [Options]

Click [Expression] kemudian lakukan setting expression:

Tentukan lokasi file output kemudian Click [OK] lalu jalankan [Execute Query].

Hasil file [Peta Bidang.txt]:

Langkah-langkah yang diuraikan di atas menggunakan tool yang ada di autocadmap atau fasilitas Map jika di civil 3d.

Jika ada waktu dan kesempatan, saya akan mencoba membuat vba / macro di excel sehingga fungsi seperti di atas bisa berjalan di autocad biasa tanpa ada tool mapnya.

==thanks for reading my blogs.

[CAD-MAP-001]: Menghitung Luas Bidang Tanah dengan Autocadmap

Referensi	:
Platform	:	AutocadMap
Lokasi File	:	tidak tersedia

Luas bidang tanah yang telah tergambar di autocadmap bisa dihitung luasnya dengan menggunakan fasilitas topologi. Ada tiga jenis topologi dalam autocadmap yaitu topology garis / network, topology titik /point dan topologi polygon. Jenis topology polygon adalah topology yang sesuai untuk proses perhitungan luas karena dalam pembuatan topologi polygon salah satu informasi yang didapat adalah luasan polygon tertutup.

Melalui "Topology Query", hasil topology tersebut bisa diexport ke text (ascii) file untuk dibuatkan daftar atau list informasi luas untuk tiap id bidang dan juga bisa menampilkan text informasi luas secara otomatis di autocadmap.

Agar memudahkan saat proses editing gambar dalam pembuatan topologi, berikut adalah syarat-syarat gambar yang akan dibuat topology polygon berdasarkan pengalaman saya:

Pembatas bidang tersebut terletak di layer yang sama atau dalam satu layer
Pembatas bidang bertipe line atau polyline atau lwpolyline dua (2) dimensi
Tiap satu bidang tanah mempunyai satu centroid atau kode bidang bisa berupa text atau blok attribute
Pembatas bidang harus tertutup

Berikut contoh gambar beberapa bidang tanah yang akan dihitung luasannya dengan topology polygon:

Syarat #1: Cek pembatas bidang terletak dalam satu layer

Pilih salah satu garis pembatas bidang kemudian rubah warna layernya sehingga warna garis berbeda dengan pembatas yang lain. Dalam contoh gambar ini, layer pembatas bidang adalah : 020100. Layer tersebut kemudian diberi warna merah.

Garis yang ditandai kuning adalah bukan pembatas bidang atau pembatas bidang tetapi belum atau tidak complete. Rubah layer garis yang ditandai tersebut menjadi layer lain.

Text berwarna merah adalah text yang seharusnya bukan menjadi pembatas bidang sehingga text tersebut harus dikeluarkan dari layer pembatas bidang.

Gambar setelah editing layer batas bidang:

Syarat #2: Pembatas bidang berupa LINE, POLYLINE atau LWPOLYLINE dua (2) dimensi

Telah dijelaskan di atas bahwa layer untuk object pembatas bidang adalah 020100 sehingga object dalam layer tersebut harus berisi object LINE, POLYLINE atau LWPOLYLINE. Cara mengecek type object dalam sebuah layer adalah sebagai berikut:

2.1. Ketik pada command: QSELECT

lakukan setting atau pilihan

Properties: Layer

Operators: = Equals

Value: 020100

kemudian click [OK]

Semua object dalam layer 020100 akan terpilh (selected)

2.2. Ketik lagi pada command:QSELECT

lakukan setting

Apply to: Current selection

Click object type

Ternyata dalam layer yang 020100 masih ada object lain selain line dan Polyline yaitu Text dan Point

Pilih Object Type Text kemudian rubah layernya

2.3. Ulang langka 2.2. sehingga object type di layer 020100 hanya terdiri dari Multiple, LINE dan POLYLINE

Syarat #3: Tiap satu bidang harus mempunyai satu (1) id sebagai centroid.

Pada contoh gambar di atas ID bidang adalah berupa text yang berisi lima digit angka yang diletakkan di layer 080201. Rubah warna layer ini sehingga mudah untuk diidentifikasi kemudian lakukan checking type object yang ada pada layer ini. Karena ID bidang berupa text, maka pada layer ini harus terdiri dari object yang berupa text saja. Lakukan langkah-langkah yang telah diuraikan di atas untuk mengecekan object.

Jika sudah dilakukan checking type object, matikan semua layer kecuali layer batas bidang (020100) dan layer id (080201)

Syarat #4: Pembatas bidang harus tertup.

Bagian yang ditandai biru adalah bidang yang belum tertutup sehingga diperlukan editing lebih lanjut pada pembatas bidang tersebut. Dalam gambar ini proses editing yang dilakukan adalah memotong (break) garis lama yang sebelumnya ada di layer 040100 menjadi layer 020100 (layer batas bidang).

Gambar menjadi:

Gambar di atas sudah siap dilakukan proses pembuatan polygon topology dengan tahapan sebagai berikut:

Cleaning Gambar

Ketik pada command: MAPCLEAN

Pilih [Select All]
Pada Layers masukkan layer batas bidang (120100)
Click [Next

Clean up options, pilih cleanup actions:

Delete Duplicates: untuk menghapus garis atau polyline yang duplicates
Erase Short Objects: menghapus object garis yang sangat pendek
Break Crossing Object: otomatis break garis jika saling berpotongan
Snap Clustered Nodes: node yang berdekatan akan otomatis bersatu.

click [Next]

Pilih [Modify original objects] di [Cleanup Method]
Click [Finish]

Pembuatan Topologi

Ketik pada command: MAPWSPACE kemudian pilih [On] Setelah proses ini, task pan autocadmap akan ditampilkan seperti gambar di samping Pilih Tab [Map Explorer]
Click kanan [Topologies], kemudian pilih [Create]
Pilih Topology Type: Polygon Topology Name (misal):bd Click tombol [Next]
Pilih Select All Click simbol layer, kemudian pilih layer pembatas bidang 020100 Click tombol [Next]
Select Nodes. Pilih Select All Click tombol [Next]
Create New Nodes, uncheck pilhan create new nodes Click [Next]
Select Centroids. Pilh Select All Click simbol layer, kemudian pilih layer yang berisi text di bidang (080201) Click [Next]
Create New Centroid. Uncheck pilihan create missing centroids Click [Next]
Error Markers: Polygon tanpa ID ditandai dengan Rhombus warna Cyan Polyon yang saling berpotongan ditandai dengan octagon warna Green Polygon dengan ID lebih dari satu ditandai dengan square warna red Polygon yang tidak menutup tidandai dengan triangle warna yellow Clck [Finish]
Setelah click [Finish], jika ada kesalahan polygon, autocadmap memunculkan kotak peringatan. Pada contoh kali ini diidentifikasi sebagai polygon yang saling berpotongan atau (intersections detected) click [Close] kemudian cari symbol octagon yang berwarna green atau hijau.
Pada gambar disamping ternyata ada double polygon atau batas bidang yang bertumpuk. Saya hapus bidang yang double tersebut sehingga tidak ada double
Ulangi langkah 1-18 setelah diulang langkah di atas, pesan error yang muncul adalah Link doesn’t belong to any polygon Error ini menandakan bahwa ada polygon yang belum menutup atau belum ada break line di perpotongan garis. Error ditandai dengan segitiga warna kuning.
Contoh error dan koreksinya: Ditemukan polygon yang tidak menutup sempurna (lingkaran hijau) sehingga menyebabkan polygon terbuka. Lakukan trim garis di lingkaran hijau
Gambar setelah dikoreksi
Contoh garis yang harus di-break Pada gambar disamping garis yang terpilih harus dipecah atau break Gunakan perintah break sehingga garis yang terpilih menjadi dua garis seperti gambar di bawahnya.’	setelah diedit:
Jika tidak ada error, maka ada tambahan topology di map explorer
Untuk mengetahui informasi luas dari hasil topology polygon: Click icon atau ketik di command: ADEEDITDATA Pilih ID bidang (text di layer 080201)

Sampai pada tahap ini proses pembuatan topologi telah selesai. Tahap selanjutnya adalah mengexport list informasi luas tersebut ke text file melalui tahapan berikut:

Klik kanan nama topology di map explorer kemudian pilih Analysis>>Topology Query
Lakukan setting di Topology Query: Topology Type: None Click [Define Query]
Set di [Define Query Topology]: Click [Location], kemudian pilih [Boundary Type]: All [Query Mode]: Report Click [Options]
Pada [Output Report Options], click [Expression…] Pada group [Properties], pilih String] kemudian clik [OK] lalu click [Add] Click lagi [Expression…], kemudian di bawah group [Topologies] pilih Topology Polygon:bd Pada group [Polygon Centroid], pilih [Area] Click [OK] Clik [Add] Click [Browse], kemudian pilih folder tempat menyimpan hasil report query
Output Report Options menjadi Hasil report akan disimpan dalam file peta_bidang.txt dalam format comma delimeted dengan susunan kolom pertama (.STRING) adalah nomer ID Bidang dan kolom kedua (.AREA@TPMCNTR_bd) adalah informasi luas dari topology bd Click [OK] Click [Execute Query]
Hasil report query di file peta_bidang.txt File tersebut bisa juga dibuka dengan mirosoft excel ataupun diimport ke Microsoft access atau file database lainnya

Untuk menampilkan text informasi luas di autocadmap lakukan langkah-langkah seperti berikut:

Buat Layer baru khusus untuk text informasi luas. Misal txtLuas
Lakukan seperti langkah 1 & 2 seperti di atas
Setting di [Define Query Topology] Click [Clear Query] untuk menghilangkan query sebelumnya Click [Location]>>[Boundary Type]:All [Query Mode]: Draw Check opsi sebelah kiri [Alter Properties…] Click [Alter Properties..] Pada group [Select Property], click [Text]
Seeting di [Define Text]: Click [Expression] Pada [Text Value Expression] pilih [Topologies]>>[Polygon:bd]>>[Polygon Centroid]>>[Area] Click [OK] bd adalah nama topology polygon yang telah dibuat. Hasil Text Value disamping adalah mencetak informasi luas di layer:txtLuas dengan banyaknya angka di belakang tanda desimal sebanyak 13 digit seperti seperti hasil report query pada langkah 6 di atas.
Merubah tampilan text luas. Rubah text value seperti petunjuk di samping Click [OK]	Text value semula :AREA@TPMCNTR_bd Menjadi (STRCAT "LUAS : " (FIX :AREA@TPMCNTR_bd) " M2") Property Alteration menjadi:
Click [Execute] di [Define of Query Topology] Tampilan setelah ada informasi luas Text luas berhimpit dengan text id bidang
Agar tampilan luas berada di bawah nomor ID bidang. Lakukan Langkah berikut: Ketik di command:QSELECT Properties: Layer Operator: = Equal Value: txtLuas Click [OK] Ketik command: MOVE Geser ke Bawah

Posting berikutnya akan dicoba untuk me-link-an antara database yang tersimpan dalam database access atau excel yang berisi daftar nama dan informasi lain sehingga dalam file autocadmap bisa disajikan peta tematik tematik yang lebih informative.

===Selamat mencoba===

[CAD-LIS-03]: Autolisp untuk plotting titik dari text file type comma delimited (text dengan pemisah tanda Koma) ke AutoCAD

Referensi	:	http://www.afralisp.net/dialog-control-language/
		http://www.lee-mac.com/stringtolist.html
Lokasi File	:

Setelah belajar di http://www.afralisp.net/dialog-control-language/ tentang bagaimana cara membuat kotak dialog dengan Dialog Control Language (DCL), berikut adalah hasil praktik saya untuk penerapan import / penggambaran titik dari textfile dengan pemisah koma (comma delimited).

Penerapan program autolisp dengan DCL ini merupakan pengembangan lebih lanjut dari https://cadex.co/2009/04/17/cad-lis-01-menulis-text-dari-list-koordinat/ dengan penambahan kotak dialog, pemilihan kolom dan type titik yang bisa dipilih berupa block atau berupa titik dan text. Jika dibandingkan dengan program sebelumnya, pada program ini belum ada setting [text style] dan [Layer] karena saya masih kesulitan untuk membuat text style melalui visual lisp yang berbasis object oriented programming. Tentunya jika sudah mendapatkan caranya, akan saya update program autolispnya.

Untuk menjalankan program autolisp dan DCL beserta dengan block attributesnya, maka perlu ditambahkan setting khusus di program AutoCAD dengan menambahkan 2 (dua) folder / path pada options [Support File Searh Path] dengan cara sebagai berikut:

1. Download program autolisp & DCL

2. Ketik pada program autocad pada menu command: options

3. Pada [Tab], [Files], pilih [Support File Searh Path], kemudian click tombol [Add].

4. Click tombol [Browse], arahkan ke folder […..\cadex\lsp], kemudian click [Apply]

5. Ulangi langkah 3 dan 4, menambahkan folder […\cadex\blocks], kemudian click [Apply]

6. Tutup kotak click tombol [OK]

Pada tulisan ini saya tidak menguraikan atau menjelaskan baris per baris perintah autolispnya karena sebagian sudah saya tulis beberapa komentar pada program autolisp yang saya berri nama cadex.lsp. Program lisp ini akan saya update jika ada tambahan program autolisp baru.

Berikut langkah-langkah menjalankan program autolisp di AutoCAD:

A. Setting program cadex.lsp di AutoCAD

1. Load / masukkan program lisp dalam Autocad dengan mengetik di command:appload

2. Pilih file cadex.lsp pada folder […..\cadex\lsp], kemudian click [Load]

3. Jika muncul pesan "security issued", centang pilihan [Alwas Load] kemudian click [Load] lagi.

4. Click tombol [Close], jika sudah selesai.

B. Menjalankan program cadex.lsp

1. Program import titik ada fungsi (c:z_p), untuk menjalankan program tersebut, ketik di command:z_p

2. Akan ditampilkan kotak dialog [Import Titik dari [*.csv] atau [*.txt] file] hasil program DCL dari file penzd.dcl

3. Click tombol [Browse], kemudian pilih file yang akan diimport dengan terlebih dahulu memilih type extensi filenya *.csv atau *.txt, kemudian click [Lihat Data]

4. Secara default, program akan membaca titik mulai baris 1, nomor titik di kolom 1 , keterangan di kolom 1, X di kolom 2 , Y di kolom 3 dan Z / elevasi di kolom 4

5. Kemudian pilih [Format Titik dan text], apabila titik akan ditampilkan dalam bentuk titik beserta dengan text keterangan atau pilih [Block Attributes] jika akan mengeplot dalam bentuk Block Attrubutes. Catatan: untuk pilihan Block Attributes akan terplot lebih lama dibandingkan dengan pilihan [Format Titik dan Text]

6. Click tombol [OK], untuk mulai plotting titik.

==selamat mencoba===

[DOC-VBA-02]: Aplikasi Fungsi Terbilang di Microsoft Word Rev.1

Referensi	:	[DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word
Platform	:	Microsot Word
Lokasi File	:	Download

Pada tulisan [DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word code diambil dari https://support.microsoft.com/en-us/kb/213360 dengan sedikit modifikasi.

Sedangkan pada tulisan ini adalah versi Visual Basic Application (VBA) dari [XLS-PMG-08]: Fungsi Terbilang Di Excel Tanpa Macro Versi Mega Formula Rev.03 berupa macro sehingga bisa digunakan di Microsoft Word.

Ada dua Procedure / Macro dan dua Fungsi dalam VBA tersebut :

Procedure / Macro	Fungsi yang dijalankan	Keterangan
Terbilang	fTerbilang	untuk mengubah angka ke bahasa indonesia
Spell2Number	fSpellNumber	untuk mengubah angka ke bahasa inggris

1. Procedure / Macro Terbilang

Sub Terbilang()
Selection.Text = fTerbilang(Selection.Text)
End Sub

Function fTerbilang(dAngka As Variant)

‘Keterangan : Fungsi ini akan merubah angka menjadi huruf atau terbilang
‘maksimal angka adalah 999999999999.99
‘jika melebihi angka tersebut tidak akan diproses.
‘dibuat oleh: zainul_ulum@cbn.net.id
‘Rev.0: 15 Oktober 2017
    Const dMAX_NUMBER As Double = 999999999999.99
    Const sFormat As String = "000000000000.00"
    Dim arrHuruf As Variant

    arrHuruf = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", _
        "delapan", "sembilan", "sepuluh", "sebelas", "dua belas", "tiga belas", _
        "empat belas", "lima belas", "enam belas", "tujuh belas", "delapan belas", _
        "sembilan belas", "dua puluh", "tiga puluh", "empat puluh", "lima puluh", _
        "enam puluh", "tujuh puluh", "delapan puluh", "sembilan puluh")

    ‘Dim dAngka As Double
    ‘dAngka = 134912931#

    If dAngka > dMAX_NUMBER Then
        fTerbilang = "N/A"
        Exit Function
    End If

    Dim sAngka As String

    ‘merubah angka menjadi string
    sAngka = Format(dAngka, sFormat)

    Dim iRatusan As Integer, iPuluhan As Integer
    Dim idxHuruf As Integer, j As Integer, k As Integer
    Dim sTerbilang As String, sTerbilangPenuh As String
    Dim sRatusan As String, sPuluhan As String

    j = 1
    sTerbilangPenuh = ""
    For k = 0 To 3
    ‘angka ratusan
    iRatusan = CInt(Mid(sAngka, j, 1))

    ‘membaca angka Ratusan
    sRatusan = IIf(iRatusan = 0, "", arrHuruf(iRatusan) & " ratus")

    ‘mengganti "satu ratus" menjadi "seratus"
    sRatusan = Replace(sRatusan, "satu ratus", "seratus")

    ‘angka Puluhan
    iPuluhan = CInt(Mid(sAngka, j + 1, 2))
    If iPuluhan <= 19 Then
        sPuluhan = arrHuruf(iPuluhan)
    Else
        sPuluhan = arrHuruf(18 + CInt(Left(iPuluhan, 1)))
        sPuluhan = sPuluhan & " " & arrHuruf(CInt(Right(iPuluhan, 1)))
    End If
    sTerbilang = sRatusan & " " & sPuluhan

    ‘menambahkan kata milyar
    Select Case k
        Case 0
            sTerbilang = sTerbilang & IIf(dAngka / 1000000000# > 1, " milyar", "")
        Case 1
            sTerbilang = sTerbilang & IIf(dAngka / 1000000# > 1, " juta", "")
        Case 2
            sTerbilang = sTerbilang & IIf(dAngka / 1000# > 1, " ribu", "")
            ‘mengganti "satu ribu" menjadi "seribu"
            sTerbilang = Replace(sTerbilang, "satu ribu", "seribu")
        Case Else
            sTerbilang = sTerbilang
    End Select
    sTerbilangPenuh = sTerbilangPenuh & " " & sTerbilang
    j = j + 3
    Next k

    ‘membaca sen
    Dim iSen As Integer, sSen As String
    iSen = CInt(Right(sAngka, 2))

    If iSen <= 19 Then
            sSen = arrHuruf(iSen)
        Else
            sSen = arrHuruf(18 + CInt(Left(iSen, 1)))
            sSen = sSen & " " & arrHuruf(CInt(Right(iSen, 1)))
    End If

    fTerbilang = Trim(sTerbilangPenuh & IIf(iSen = 0, "", " dan " & sSen & " sen"))

End Function

2. Procedure / Macro Spell2Number

Sub Spell2Number()
Selection.Text = fSpellNumber(Selection.Text)
End Sub

Function fSpellNumber(dAngka As Variant)

‘Descrition : This function converts number into text or spells number into text
‘maximum number can be converted is 999999999999.99
‘Function return "N/A" if the number exceeds of the allowable maximum number
‘coded by: zainul_ulum@cbn.net.id
‘Rev.0: 15 Oktober 2017


    Const sFormat As String = "000000000000.00"
    Const dMAX_NUMBER As Double = 999999999999.99
    Dim arrHuruf As Variant

    arrHuruf = Array("", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", _
    "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", _
    "eighteen", "nineteen", "twenty-", "thirty-", "forty-", "fifty-", "sixty-", "seventy-", "eighty-", "ninety-")

    ‘Dim dAngka As Double
    ‘dAngka = 134912931#
    If dAngka > dMAX_NUMBER Then
        fSpellNumber = "N/A"
        Exit Function
    End If

    Dim sAngka As String

    ‘merubah angka menjadi string
    sAngka = Format(dAngka, sFormat)

    Dim iRatusan As Integer, iPuluhan As Integer
    Dim idxHuruf As Integer, j As Integer, k As Integer
    Dim sTerbilang As String, sTerbilangPenuh As String
    Dim sRatusan As String, sPuluhan As String

    j = 1
    sTerbilangPenuh = ""
    For k = 0 To 3
    ‘angka ratusan
    iRatusan = CInt(Mid(sAngka, j, 1))

    ‘membaca angka Ratusan
    sRatusan = IIf(iRatusan = 0, "", arrHuruf(iRatusan) & " hundred")

    ‘mengganti "satu ratus" menjadi "seratus"
    ‘sRatusan = Replace(sRatusan, "satu ratus", "seratus")

    ‘angka Puluhan
    iPuluhan = CInt(Mid(sAngka, j + 1, 2))
    If iPuluhan <= 19 Then
        sPuluhan = arrHuruf(iPuluhan)
    Else
        sPuluhan = arrHuruf(18 + CInt(Left(iPuluhan, 1)))
        sPuluhan = sPuluhan & arrHuruf(CInt(Right(iPuluhan, 1)))
    End If
    sTerbilang = sRatusan & " " & sPuluhan

    ‘menambahkan kata milyar
    Select Case k
        Case 0
            sTerbilang = sTerbilang & IIf(dAngka / 1000000000# > 1, " billion", "")
        Case 1
            sTerbilang = sTerbilang & IIf(dAngka / 1000000# > 1, " million", "")
        Case 2
            sTerbilang = sTerbilang & IIf(dAngka / 1000# > 1, " thousand", "")
            ‘mengganti "satu ribu" menjadi "seribu"
            ‘sTerbilang = Replace(sTerbilang, "satu ribu", "seribu")
        Case Else
            sTerbilang = sTerbilang
    End Select
    sTerbilangPenuh = sTerbilangPenuh & " " & sTerbilang
    j = j + 3
    Next k

    ‘membaca sen
    Dim iSen As Integer, sSen As String
    iSen = CInt(Right(sAngka, 2))

    If iSen <= 19 Then
            sSen = arrHuruf(iSen)
        Else
            sSen = arrHuruf(18 + CInt(Left(iSen, 1)))
            sSen = sSen & arrHuruf(CInt(Right(iSen, 1)))
    End If

    fSpellNumber = Trim(sTerbilangPenuh & IIf(iSen = 0, "", " and " & sSen & " cent" & IIf(iSen > 1, "s", "")))

End Function

Cara penggunaan silakan baca di tulisan sebelumnya [DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word.

==semoga bermanfaat==

[XLS-PMG-08]: Fungsi Terbilang di Excel Tanpa Macro Versi Mega Formula Rev.03

Referensi	:	[XLS-PMG-06]:Fungsi Terbilang Di Excel Tanpa Macro (Versi Mega Formula) Rev.02
Platform	:	Excel 2007
Lokasi File	:	Download

Tulisan ini adalah revisi ketiga dari posting sebelumnya dengan melakukan beberapa perubahan antara lain:

	Rev.02	Rev.03
Panjang rumus konversi angka ke huruf:
— Versi bahasa indonesia	1741	1362
— Versi bahasa inggris tanpa cents	2187
— Versi bahasa indonesia dengan sen		1620
— Versi bahsa inggris dengan cents		1376

Secara garis besar urutan untuk merubah angka menjadi huruf adalah:

A. VERSI KONVERSI TANPA ANGKA DESIMAL

Secara umum urutan yang saya pakai untuk merubah angka menjadi huruf adalah:

1. Proses pembacaan angka ke huruf dengan menggunakan bantuan 3 (tiga) “Named Range” yaitu:

— Named Range untuk memformat angka: _frm=REPT("0",12)

— Named Range larik/array angka: _angka={0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,30,40,50,60,70,80,90}

–Named Range larik/array huruf: _huruf={"","satu","dua","tiga","empat","lima","enam","tujuh","delapan","sembilan","sepuluh","sebelas","dua belas","tiga belas","empat belas","lima belas","enam belas","tujuh belas","delapan belas","sembilan belas","dua puluh","tiga puluh","empat puluh","lima puluh","enam puluh","tujuh puluh","delapan puluh","sembilan puluh"}

2. Format angka menjadi format text dengan panjang 12 karakter.

Misal angka di cell [A1] berisi angka 111456789876 (12 karakter), maka dengan menggunakan fungsi =TEXT(A1,_frm) menjadi 111456789876 (12 karakter)

3. Angka digrupkan atau dibagi menjadi 4 (empat) yaitu : [Grup Milyar]= 111, [Grup Juta]= 457, [Grup Ribu]= 898 dan [Grup Satuan]= 876

4. Proses konversi dimulai berurutan dari [Grup Milyar], [Grup Juta],[Grup Ribu] dan [Grup Satuan]. Masing-masing grup terdiri dari [Ratusan] dan [Puluhan].

4.1 Konver Angka Milyar-an atau [Grup Milyar]

[Grup Milyar]=111 terdiri dari [Ratusan]= 1 dan [Puluhan]= 11

A. Konversi Angka Ratusan ke Huruf

Angka [Ratusan] diambil dengan rumus =MID(TEXT(A2,_frm),1,1)

Dengan menggunakan fungsi =INDEX(_huruf,[Ratusan]+1) atau =INDEX(_huruf,1+1) akan mengambil isi array _huruf yang ke 2 yaitu kata “satu” kemudian ditambahkan kata “ratus” sehingga rumusnya menjadi =INDEX(_huruf,1+1) & “ ratus”

Karena bahasa indonesia tidak mengenal kalimat “satu ratus”, maka rumus =INDEX(_huruf,1+1) & “ ratus” hanya berlaku jika [Ratusan]>1 sehinga jika [Ratusan]= 1 tidak dilakukan pengambilan isi array _huruf tetapi langsung dirubah menjadi kata “seratus”.

Fungsi –MID(TEXT(A1,_frm),1,1)=1 untuk mengecek [Ratusan]=1, sedangkan –MID(TEXT(A1,_frm),1,1)>1 untuk mengecek [Ratusan]>1. Tanda double minus “–“ di depan MID berfungsi untuk merubah text “1” dari fungsi MID(TEXT(A1,_frm),1,1) menjadi angka 1.

Sedangkan untuk menampilkan menampilkan angka [Ratusan]=1 menggunakan fungsi

=REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)

dan fungsi

=REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)

untuk menampilkan [Ratusan]>1

Apabila digabungkan Fungsi [Ratusan] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)

B. Konversi Angka Puluhan ke Huruf

Angka [Puluhan] diambil dengan fungsi =MID(TEXT(A1,_frm),2,2).

Hasil rumus ini kemudian dicek lagi jika [Puluhan]<=19, maka proses konversi langsung mengambil index dari array/larik _huruf dengan fungsi:

=INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)

sedangkan jika [Puluhan]>19, maka proses konversi dua tahap yaitu mengambil angka bulan puluhan di tambah dengan angka satuannya.

Fungsi untuk mengambil angka bulat untuk [Puluhan]>19

=LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf)

dan untuk mengambil angka satuannya:

=INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1))

Gabungan fungsi [Puluhan] menjadi:

=IF(–MID(TEXT(A1,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)),LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1)))

Sedangkan fungsi gabungan [Ratusan] dan [Puluhan] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)),LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1)))

Fungsi di atas akan ditambahkan kata “milyar” jika nilai angka yang akan dikonversi lebih lebih dari satu milyar. Rumus untuk mengecek angka mencapai milyaran adalah:

=REPT(" milyar",(TEXT(A1,_frm)/10^9)>1)

Sehingga untuk grup [Milyar] dengan akhiran “ milyar” fungsinya menjadi:

4.2 Konversi Angka Juta-an atau [Grup Juta]

Angka juta-an atau [Grup Juta] didapat dengan memodifikasi fungsi / rumus MID() dari fungsi di atas.

=MID(TEXT(A1,_frm),1,1), artinya mengambil huruf dari text A1 yang telah diformat mulai dari huruf ke-1 sebanyak 1 huruf. Jika pengambilan karakter dimulai dari huruf ke 4 atau huruf ke-(1+3) akan didapat huruf ratusan dari [Grup Jutaan].

kemudian dengan memodifikasi REPT(" milyar",(TEXT(A1,_frm)/10^9)>1) menjadi REPT(" juta",(TEXT(A1,_frm)/10^3)>1) maka akan merubah akhiran “ milyar” menjadi “ juta”

Fungsi [Grup Juta] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),4,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),4,1)) &" ratus",–MID(TEXT(A1,_frm),4,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),5,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),5,2)),LOOKUP(–MID(TEXT(A1,_frm),5,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),6,1)))&REPT(" juta",(TEXT(A1,_frm)/10^6)>1)

4.3 Konversi Angka Ribua-an atau [Grup Ribu]

Dengan memodifikasi fungsi [Grup Juta], fungsi [Grup Ribu] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),7,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),7,1)) &" ratus",–MID(TEXT(A1,_frm),7,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),8,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),8,2)),LOOKUP(–MID(TEXT(A1,_frm),8,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),9,1)))&REPT(" ribu",(TEXT(A1,_frm)/10^3)>1)

Karena dalam bahasa indonesia tidak ada kalimat “satu ribu” maka diperlukan ditambahkan fungsi SUBSTITUTE () untuk merubah “satu ribu” menjadi “seribu”

=SUBSTITUTE(REPT("seratus ",–MID(TEXT(A1,_frm),7,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),7,1)) &" ratus",–MID(TEXT(A1,_frm),7,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),8,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),8,2)),LOOKUP(–MID(TEXT(A1,_frm),8,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),9,1)))&REPT(" ribu",(TEXT(A1,_frm)/10^3)>1),"satu ribu","seribu")

4.4. Konversi Angka Satuan [Grup Satuan]

Hasil modifikasi [Grup Ribu], funsi [Grup Satuan] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),10,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),10,1)) &" ratus",–MID(TEXT(A1,_frm),10,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),11,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),11,2)),LOOKUP(–MID(TEXT(A1,_frm),11,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),12,1)))

Rumus lengkap konversi angka ke huruf tanpa angka desimal:

=TRIM(REPT("seratus ",–MID(TEXT(A7,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A7,_frm),1,1)) &" ratus",–MID(TEXT(A7,_frm),1,1)>1)&" "
&IF(–MID(TEXT(A7,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A7,_frm),2,2)),LOOKUP(–MID(TEXT(A7,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A7,_frm),3,1)))&REPT(" milyar",(TEXT(A7,_frm)/10^9)>1)&" "

&REPT("seratus ",–MID(TEXT(A7,_frm),4,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A7,_frm),4,1)) &" ratus",–MID(TEXT(A7,_frm),4,1)>1)&" "
&IF(–MID(TEXT(A7,_frm),5,2)<=19,INDEX(_huruf,1+MID(TEXT(A7,_frm),5,2)),LOOKUP(–MID(TEXT(A7,_frm),5,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A7,_frm),6,1)))&REPT(" juta",(TEXT(A7,_frm)/10^6)>1)&" "

&SUBSTITUTE(
REPT("seratus ",–MID(TEXT(A7,_frm),7,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A7,_frm),7,1)) &" ratus",–MID(TEXT(A7,_frm),7,1)>1)&" "
&IF(–MID(TEXT(A7,_frm),8,2)<=19,INDEX(_huruf,1+MID(TEXT(A7,_frm),8,2)),LOOKUP(–MID(TEXT(A7,_frm),8,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A7,_frm),9,1)))&REPT(" ribu",(TEXT(A7,_frm)/10^3)>1),"satu ribu","seribu")&" "

&REPT("seratus ",–MID(TEXT(A7,_frm),10,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A7,_frm),10,1)) &" ratus",–MID(TEXT(A7,_frm),10,1)>1)&" "
&IF(–MID(TEXT(A7,_frm),11,2)<=19,INDEX(_huruf,1+MID(TEXT(A7,_frm),11,2)),LOOKUP(–MID(TEXT(A7,_frm),11,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A7,_frm),12,1))))

B. VERSI KONVERSI DENGAN ANGKA DUA ANGKA DESIMAL (ANGKA DENGAN SEN)

Dengan merubah named range semula _frm=REPT("0",12) menjadi _frm=REPT("0",12)&MID(1/10,2,1)&"00" dan menambahkan fungsi di akhir rumus VERSI KONVERSI TANPA ANGKA DESIMAL:

&REPT(IF(–MID(TEXT(A1,_frm),14,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),14,2)),LOOKUP(–MID(TEXT(A1,_frm),14,2),_angka,_huruf)&" "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),15,1))) &" sen",–MID(TEXT(A1,_frm),14,2)>0)

Rumus lengkap konversi angka ke huruf dengan dua angka desimal (sen):

=TRIM(REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)),LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1)))&REPT(" milyar",(TEXT(A1,_frm)/10^9)>1)&" "

&REPT("seratus ",–MID(TEXT(A1,_frm),4,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),4,1)) &" ratus",–MID(TEXT(A1,_frm),4,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),5,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),5,2)),LOOKUP(–MID(TEXT(A1,_frm),5,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),6,1)))&REPT(" juta",(TEXT(A1,_frm)/10^6)>1)&" "

&SUBSTITUTE(
REPT("seratus ",–MID(TEXT(A1,_frm),7,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),7,1)) &" ratus",–MID(TEXT(A1,_frm),7,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),8,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),8,2)),LOOKUP(–MID(TEXT(A1,_frm),8,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),9,1)))&REPT(" ribu",(TEXT(A1,_frm)/10^3)>1),"satu ribu","seribu")&" "

&REPT("seratus ",–MID(TEXT(A1,_frm),10,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),10,1)) &" ratus",–MID(TEXT(A1,_frm),10,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),11,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),11,2)),LOOKUP(–MID(TEXT(A1,_frm),11,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),12,1))))&" rupiah "

Dengan metode atau cara yang sama bisa dikembangkan untuk konversi ke bahasa inggris atau bahasa lainnya.

==semoga bermanfaat==

The name ‘_’ already exist……

The name already exist

Jika saat copy sheet Microsoft excel muncul pesan di atas, sehingga harus berkali-kali menekan tombol [Yes] berkali-kali.

Berikut solusinya:

Sebelum copy sheet, aktifkan VBA Excel atau tekan tombol kombinasi [Alt+F8]
Click [ThisWokbook], kemudian ketik vba code seperti dalam gambar:
Letakkan kursor di bawah tulisan sub kemudian tekan [F5] untuk menjalankan vba
Hapus VBA Code, bisa juga disimpan di notepad jika sewaktu-waktu dibutuhkan.
Tutup VBA Editor atau tekan tombol kombinasai [Alt+Q]
Pilih Menu [Formula], kemudian pilih [Name Manager]
Block semua Name, kemudian tekan [Delete] disusul dengan [Close]
Lakukan copy sheet, maka pesan “the name already exist …” sudah tidak ada.

Trik ini juga bias digunakan apabila ada link ke external file yang tidak bias di putus (broken links)

Selamat mencoba

[XLS-SVY-24]: Plotting Cross section dari Excel ke Autocad Versi 1.2

Referensi	:	[XLS-SVY-13]: Plotting Cross Section dari Excel ke AutoCAD Versi 1.1
Platform	:
Lokasi File	:	download

Tulisan ini adalah tindak lanjut dari beberapa comments/komentar dari posting [XLS-SVY-13]: Plotting Cross Section dari Excel ke AutoCAD Versi 1.1. Walaupun tidak semua harapan pembaca terpenuhi

Perbaikan pada versi ini adalah :

Nama program diganti dengan extensi *.xlam dan contoh file dalam format *.xlsx
Mengganti menu dengan menggunakan “Custom UI Editor” sehingga menu baru ditampilkan dalam Ribbon Menu dan bisa di jalankan oleh Microsoft Excel 2007 ke atas.
Merubah coding program menjadi metode “late binding” sehingga diharapkan program bisa dijalankan di Autocad 2000 ke atas tanpa harus setting Autocad Library.

Seperti halnya saat menjalankan program vba excel, pilih “Enable Macro” jika akan menggunakan program

Tampilan menu di Microsoft Excel 2016 :

Cara menjalankan program masih sama dengan tulisan pada [XLS-SVY-13]: Plotting Cross Section dari Excel ke AutoCAD Versi 1.1:

~~ selamat mencoba ~~

[CAD-LIS-02]: Autolisp untuk Membuat Pendekatan Lingkaran dari Beberapa Titik (Best Fitting Circle from Coordinates)

Referensi	:	[XLS-SVY-23]: Spreadsheet Excel untuk Menentukan Pusat dan Jari-Jari Lingkaran dari Koordinat
Lokasi File	:
Perangkat Lunak	:	Autocad

Pada tulisan [XLS-SVY-23]: Spreadsheet Excel untuk Menentukan Pusat dan Jari-Jari Lingkaran dari Koordinat, pusat dan jari-jari lingkaran dihitung dengan program excel dan hasilnya ditampilkand dalam bentuk chart excel.

Tulisan kali ini adalah aplikasinya dalam bentuk program autolisp, sehingga hasil hitungan pusat dan jari-jari lingkaran bisa langsung digambar di autocad dari titik-titik / object points yang sebelumnya sudah digambar di autocad.

Berikut list autolispnya:

(defun c:fc()
;menentukan batas pemilihan
(setq p1 (getpoint));batas atas
(setq p2 (getcorner p1));batas bawah

;dipilih hanya object bertype "POINT"
(setq ss (ssget "_w" p1 p2 ‘((0 . "POINT"))))
(setq nPts (sslength ss));jumlah titik yang terplih

;jika jumlah titik >= 3 , maka akan diproses perhitungannya
(if (>= nPts 3)
    (progn
      (setq idx 0)
      (setq ListX (list));list koordinat X
      (setq ListY (list));list koordinat Y
      ;memilah atau mengambil entity titik
      (setq SumX 0 SumY 0)
      (repeat nPts
    (setq ePt (entget (ssname ss idx)))
    (setq X (nth 1 (assoc 10 ePt)))
    (setq Y (nth 2 (assoc 10 ePt)))
    (setq ListX (append ListX (list X)))
    (setq ListY (append ListY (list Y)))

    (setq SumX (+ SumX X))
    (setq SumY (+ SumY Y))
    (setq idx (1+ idx))
    );repeat
      ;perhitungan least square
      (setq Xr (/ SumX nPts))
      (setq Yr (/ SumY nPts))
      (setq idx 0)
      (setq spp 0 sppp 0)
      (setq sqq 0 sqqq 0)
      (setq spq 0 spqq 0 sqpp 0)
      (repeat nPts
    (setq p (- (nth idx ListX) Xr))
    (setq q (- (nth idx ListY) Yr))
    (setq pp (* p p))
    (setq ppp (* pp p))
    (setq qq (* q q))
    (setq qqq (* qq q))
    (setq pq (* p q))
    (setq pqq (* pq q))
    (setq qp (* q p))
    (setq qpp (* qp p))

    (setq spp (+ spp pp))
    (setq sppp (+ sppp ppp))

    (setq sqq (+ sqq qq))
    (setq sqqq (+ sqqq qqq))

    (setq spq (+ spq pq))
    (setq spqq (+ spqq pqq))
    (setq sqpp (+ sqpp qpp))

    (setq idx (1+ idx))
    );end repeat
      ;menghitung invers matrix A (2×2)
      ;|a11 a12| = |spp spq|
       |a21 a21| = |spq sqq|;

(setq det (- (* spp sqq ) (* spq spq)))

      (setq a11 (/ sqq det))
      (setq a12 (/ (* -1.0 spq) det))
      (setq a21 a12)
      (setq a22 (/ spp det))

      ;matrix L (2×1)
      (setq l11 (/ (+ spqq sppp) 2.0))
      (setq l21 (/ (+ sqqq sqpp) 2.0))

(setq xx (+ (* a11 l11) (* a12 l21)))
(setq yy (+ (* a21 l11) (* a22 l21)))

      ;koordinat pusat lingkaran
      (setq Xc (+ xx Xr))
      (setq Yc (+ yy Yr))
      (setq pc (list Xc Yc))

(setq Sxx (+ (* xx xx) (* yy yy)))
(setq r (+ sxx (/ (+ spp sqq) nPts)))

      ;jari-jari
      (setq r (sqrt r))
      (command "circle" pc r )

      );progn
    (alert "Number of points < 3 points")
    );if
)

copy list tersebut, kemudian simpan dengan ekstensi .lsp atau download file.

Cara penggunaan program tersebut:

1. Pada ketik menu command:appload

2. Pilih file lisp atau file hasil download.

3. Misal lokasi titik yang akan dibuat lingkarannya adalah:

4. ketik pada menu command:fc

5. Kemudian select window mulai dari kiri atas sampai kanan bawah pada semua titik di atas.

6. Hasilnya:

#selamat mencoba

[XLS-SVY-23]: Spreadsheet Excel untuk Menentukan Pusat dan Jari-Jari Lingkaran dari Koordinat

Referensi	:	Least-Squares Circle Fit by R. Bullock
Lokasi File	:	download
Platform	:	Microsoft Excel

Salah satu member di landsurveyorunited.com menanyakan program dalam spreadsheet excel untuk menentukan koordinat pusat lingkaran dan jari-jarinya dari hasil pengukuran minimal 3(tiga) koordinat di sepanjang lingkaran. Pengukuran semacam ini biasanya digunakan untuk menentukan as built tangki, pile ataupun untuk menentukan jari-jari kelengkungan suatu alignment horisontal.

Dari beberapa metode perhitungan, hitungan yang saya “anggap” paling mudah untuk diterapkan dalam spreadsheet excel adalah metode least square atau kuadrat terkecil yang ditulis oleh R. Bullock. Rumus dan tahapan perhitungan dalam spreadsheet akan mengacu ke rumus yang diuraikan dalam paper Least-Squares Circle Fit by R. Bullock

Mengacu ke contoh koordinat dalam paper tersebut, jika diplot dalam chart excel:

List Koordinat	Chart di Excel

Bentuk spreadsheet dalam excel dengan hasil hitungan dan chart:

Range	Keterangan
[A6:A12]	berisi nomer urut titik hasil ukuran
[B6:C12]	Koordinat hasil pengukuran
[A4]	Hitungan Jumlah titik pengukuran
[B4]	Hiutngan Rata-rata koordinat X
[C4]	Hitungan Rata-rata koordinat Y
[E:Z]	Kolom tahapan perhitungan sesuai dengan paper R. Bullock
[D6]	Hasil Koordinat X pusat lingkaran
[E6]	Hasil Koordinat Y pusat lingkaran
[F6]	Hasil jari-jari lingkaran

=silakan dicoba=

[DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word

Referensi	:	https://support.microsoft.com/en-us/kb/213360
Lokasi File	:
Platform	:	Microsoft Word

Tulisan kali ini tidak ada hubungannya dengan peta, geodesy, project management, autocad ataupun civil 3D tetapi berhubungan dengan tugas baru saya sebagai tukang ketik dan tukang catat dokumen kontrak.

Sebagai tukang ketik dan tukang catat, salah satu pekerjaan yang sering berulang adalah menuliskan angka terbilang nilai kontrak dari angka ke tulisan ( konversi angka ke huruf) menggunakan Bahasa Ingris dengan software Microsoft Word.

Sebelumnya saya menggunakan formula di [XLS-PMG-04]: Spell Number in Excel Without Macro (No VBA) untuk proses konversi ini dalam Microsoft Excel. Tetapi karena dokumen kontrak ditulis dalam Microsoft Word, saya menggunakan fasilitas Visual Basic Application for Microsoft Word (VBA for MS Word) untuk melakukan proses otomasi ini.

VBA for MS Word yang saya tulis di bawah ini adalah modifikasi code vba dari https://support.microsoft.com/en-us/kb/213360 dengan beberapa perubahan kecil antara lain:

1. Merubah vba code yang semula berupa user defined function di excel, menjadi vba code untuk digunakan di Microsoft Word.

2. Menghilangkan kata dollar dan cent. Kontrak yang saya ketik dalam mata uang rupiah dimana tidak ada satuan cents.

3. Hanya bekerja di angka bulat tanpa ada desimal.

4. Menambahkan karakter dash (“-“) di angka 20-99.

Detail vba-code ada di bawah ini:

Sub Spell2Number()
‘source: https://support.microsoft.com/en-us/kb/213360
‘modified by: zainul_ulum@cbn.net.id (znl)
‘date: 15 Mei 2016
‘modification notes:
‘1. to be applied on microsoft word
‘2. delete words: dollar dan cent
‘3. works only for integer number and no decimals
‘4. add dash character If number value between 20-99…
‘tanggal 15 Mei 2016
‘required procedures and functions:
‘1. SpellNumber
‘2. GetHundreds
‘3. GetTens
‘4. GetDigit

    Selection.Text = SpellNumber(Selection.Text)
End Sub
Private Function SpellNumber(ByVal MyNumber)
    Dim Dollars, Cents, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "
    ‘ String representation of amount.
    MyNumber = Trim(Str(MyNumber))
    ‘ Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, ".")
    ‘ Convert cents and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
                  "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace – 1))
    End If
    Count = 1
    Do While MyNumber <> ""
        Temp = GetHundreds(Right(MyNumber, 3))
        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) – 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop
    Select Case Dollars
        Case ""
            ‘Dollars = "No Dollars"
            Dollars = "" ‘>>znl
        Case "One"
            ‘Dollars = "One Dollar"
            Dollars = "One" ‘>>znl
         Case Else
            ‘Dollars = Dollars & " Dollars"
            Dollars = Dollars & " " ‘>>znl
    End Select
    Select Case Cents
        Case ""
            Cents = " and No Cents"
        Case "One"
            Cents = " and One Cent"
              Case Else
            Cents = " and " & Cents & " Cents"
    End Select
    Cents = "" ‘>>znl
    SpellNumber = Dollars & Cents
End Function

‘ Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
    Dim Result As String
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
    ‘ Convert the hundreds place.
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
    End If
    ‘ Convert the tens and ones place.
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
    Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
    End If
    GetHundreds = Result
End Function

‘ Converts a number from 10 to 99 into text.
Function GetTens(TensText)
    Dim Result As String
    Result = ""           ‘ Null out the temporary function value.
    If Val(Left(TensText, 1)) = 1 Then   ‘ If value between 10-19…
        Select Case Val(TensText)
            Case 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "Nineteen"
            Case Else
        End Select
    Else                                 ‘ If value between 20-99…
        Select Case Val(Left(TensText, 1))
            Case 2: Result = "Twenty-"
            Case 3: Result = "Thirty-"
            Case 4: Result = "Forty-"
            Case 5: Result = "Fifty-"
            Case 6: Result = "Sixty-"
            Case 7: Result = "Seventy-"
            Case 8: Result = "Eighty-"
            Case 9: Result = "Ninety-"
            Case Else
        End Select
        Result = Result & GetDigit _
            (Right(TensText, 1)) ‘ Retrieve ones place.

        ‘znl remove dash character if GetDigit=""
        If GetDigit(Right(TensText, 1)) = "" Then
            Result = Left(Result, Len(Result) – 1)
        End If

    End If
    GetTens = Result
End Function

‘ Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
    End Select
End Function

Cara menggunakan code di atas:

Copy code di atas atau download dari Link ini.
Jalankan program Microsoft Word (MS Word).
Pada Blank Document di MS Word, aktifkan Microsoft Visual Basic for Applications dengan menekan tombol Alt+F11.
“Click Kanan” [ThisDocument] di bawah [Microsot Word Objects] dalam folder [Normal], kemudian pilih [Insert]>>[Module]

5. “Paste” code di [Module] yang telah dibuat, kemudian “Click” tombol [Save]. Program telah tersimpan dalam normal template sehingga setiap kali word dijalankan, program konversi huruf siap digunakan.

6. Tutup [Microsoft Visual Basic for Applications], sehingga kembali ke Blank Document.

7. Pada Blank Document, tuliskan angka yang akan dikonversi. Misal 126752346

8. Tulisan angka sebaiknya berupa angka bulan tanpa ada simbol pemisah ribuan.

9. “Select” atau “Block” angak tadi (126752346)

10. Jalankan VBA (Macro) dengan menekan tombol Alt+F8

11. “Pilih” Macro [Spell2Number], kemudian “click” tombol [Run]

12. Angka sudah dikonversi dalam huruf dalam Bahasa Inggris.

Tahapan di bawah adalah contoh penggunaannya dalam pekerjaan saya:

1. File Normal Template sudah terdapat macro (vba) konversi.

2. Membuka file draft kontak dengan Microsoft Word kemudian menge-block angka yang akan dikonversi.

3. Menekan tombol Alt+F8 kemudian menjalankan macro [Spell2Number]

4. Hasil konversi angkan ke huruf:

Silakan mencoba.

“Jadilah tukang ketik yang kerja cerdas, bukan kerja keras”