;;autolisp untuk mengecek garis bidang tanah yang belum ada titik surveynya
;;menggunakan fungsi topology poligon di autocadmap
;;oleh: zainul_ulum@cbn.net.id
(defun c:z_cektitik( ;progam utama dijalankan dengan ketik di command:z_cektitik
/ ;local variables:
layer_garis_bidang layer_titik_bidang layer_garis_bidang_copy
msg nm_layer flag ss cen_layer nod_layer
list_titik_topology i en xy ly toponame
i offs pt pt1 pt2 aRec Records x y z pnt3D acadPoint acadText
c f f_out tulis_ke_csv
)
(setvar “osmode” 0) ;object snap tidak diaktifkan
(setvar “cmdecho” 0) ;echo command tidak diaktifkan
(setq ;definisi variable
layer_garis_bidang “020100” ;layer garis bidang yang akan cek koordinatnya
layer_titik_bidang “060800” ;layer tempat plotting titik
layer_garis_bidang_copy (strcat layer_garis_bidang “_copy”) ;layer hasil copy layer bidang
)
;;======================sub program
(defun *error* ( msg )
(setvar “cmdecho” 1)
(princ “error: “)
(princ msg)
(princ)
)
(defun buat_layer (nm_layer) ;subprogran buat layer
(if (not (tblsearch “layer” nm_layer)) ;jika nama layer belum ada
(command “._layer” “m” nm_layer “”) ;buat layer baru
);end if
)
(defun pilih_garis_di_layer (nm_layer) ;subprogram untuk memilih
(ssget “X” ;semua object di modelspace
(List (cons -4 “<AND”)
(cons -4 “<OR”)
(cons 0 “LWPOLYLINE”)(cons 0 “LINE”) ;hanya untuk object polyline dan line
(cons -4 “OR>”)
(cons 8 nm_layer) ;di layer nm_layer
(cons -4 “AND>”))
);ssget
);end defun
;=======================end subprogram
;setting layer untuk proses topology
(buat_layer (setq cen_layer (strcat layer_garis_bidang “_cen”))) ;buat layer untuk menampung centroid topology
(buat_layer (setq nod_layer (strcat layer_garis_bidang “_nod”))) ;buat layer untuk node/titik digaris/link topology
(buat_layer layer_garis_bidang_copy) ;buat layer baru jika belum ada
(foreach ly (list nod_layer cen_layer layer_garis_bidang_copy)
(command “._erase”
(ssget “x” (list (cons 8 ly))) ;hapus object berdasarkan nama layer: ly
“”)
);for
(command “._COPYTOLAYER” ;jalankan perintah COPYTOLAYER
(pilih_garis_di_layer layer_garis_bidang) ;pilih object line atau polyline di layer bidang
“” ;enter atau spasi
layer_garis_bidang_copy
“X” ;exit
);command
;set variable qaflags
;http://forums.augi.com/showthread.php?11688-Explode-in-LISP-Does-Not-Explode-Selection-Set
(setq flag (getvar “qaflags”)) ;ambil nilai variable QAFLAGS
(setvar “qaflags” 5) ;set qaflags ke 5 agar selection sets bisa di-explode
(command “._explode” ;jalankan perintah explode
(pilih_garis_di_layer layer_garis_bidang_copy) ;pilih garis dan polyline di layer hasil copy layer bidang
“”
) ;hasil explode polyline akan menjadi line
(setvar “qaflags” flag) ;kembalikan setting qflag ke nilai semula
;;
;;membuat topologi dengan pilihan create node akan dibuat titik-titik disetiap line hasil proses explode
;;
;; nama topologi : bts_bidang
(if (tpm_acexist (setq toponame “bts_bidang”)) ;jika topology bts_bidang sudah ada
(tpm_mnterase toponame) ;hapus topologi tersebut
);end if
;setting variable topology
(setq var_id (tpm_varalloc)) ;alokasi memory untuk proses topologi
(tpm_varset var_id “STOP_AT_MISSING_CNTR” 0) ;continue for missing centroid
(tpm_varset var_id “CREATE_MARKERS” 1) ;mark error locations
(tpm_varset var_id “CREATE_CNTR” 1) ;create centroid
(tpm_varset var_id “CNTR_LAYER” cen_layer) ;set layer for centroid
(tpm_varset var_id “CREATE_NODE” 1) ;create new nodes
(tpm_varset var_id “NODE_LAYER” nod_layer) ;set layer for nodes
(if (not
(tpm_mntbuild ;proses topologi
var_id ;sesuai dengan setting variable var_id
toponame ;nama topology
“topologi bidang untuk extract points” ;keterangan topologi
3 ;type=3 untuk topology polygon
(ssget “X” (list (cons 8 nod_layer))) ;setting layer nodes
(ssget “X” (list (cons 8 layer_garis_bidang_copy))) ;setting layer link
(ssget “X” (list (cons 8 cen_layer))) ;setting centroid layer
);end build topologi
)
(exit) ;keluar program jika topologi gagal
);end if
;;salah satu hasil topolgy adalah object point/nodes di tiap ujung lines di nod_layer
;;langkah selanjutnya memilih semua titik tersebut kemudian dibandingkan dengan
;;titik hasil plotting data ukuran di layer_titik_bidang
(if (setq ss (ssget “X” ;pilih semua object
(list (cons 0 “POINT”) ;type object titik / POINT
(cons 8 nod_layer) ;di layer nod_layer
)
)
)
(progn ;proses dilanjtukan jika ada object yang terpilih
(setq list_titik_topology (list)) ;variable untuk menampung titik / node topology
(setq i -1)
(repeat (sslength ss);loop ke selection set
(setq i (1+ i))
(setq en (ssname ss i));ambil entity dari selection set
(setq xy (cdr (assoc 10 (entget en))))
(setq list_titik_topology (append list_titik_topology (list xy)))
);repeat
;hapus topology dan object di layer temporary
(tpm_mnterase toponame)
(foreach ly (list nod_layer cen_layer layer_garis_bidang_copy)
(command “._erase”
(ssget “x” (list (cons 8 ly))) ;hapus object berdasarkan nama layer: ly
“”)
);for
;memilih object titik di layer_titik_bidang dengan menggunakan
;koordinat yang telah disimpan di variable list_titik_topology
(setq i 0 offs 1 Records (list))
(foreach pt list_titik_topology
(setq pt1 (list (nth 0 pt) (+ (nth 1 pt) offs))) ;awal selection by fence
(setq pt2 (list (nth 0 pt) (- (nth 1 pt) offs))) ;akhir pilihan by fence
(if (not (setq ss (ssget “_F” ;select by fence
(list pt1 pt2) ;dari pt1 ke pt2
(list (cons 0 “POINT”)(cons 8 layer_titik_bidang));untuk object titik di layer_titik_bidang
)
)) ;jika tidak ditemukan titik di layer_titik_bidang
(progn ;proses ambil titik topology
(setq i (1+ i))
(setq aRec (list i (nth 0 pt) (nth 1 pt)))
(setq Records (append Records (list aRec)))
);progn
);end if
);next
);progn
);end if
;plot lokasi titik tambahan untuk cek dan simpan list koordinat di csv file
(setvar “clayer” nod_layer) ;plot titik di layer nod_layer
(vl-load-com) ;activekan com
(setq
acadDoc (vla-get-activedocument (vlax-get-acad-object)) ;object acaddocument
mSpace (vlax-get-property acadDoc ‘ModelSpace) ;object modelspace
dTextHeight 1.0
c “,” ;delimited
f_out (strcat (getvar “dwgprefix”)(getvar “dwgname”)) ;nama file di folder dwg+nama dwg
f_out (substr f_out 1 (- (strlen f_out) 3)) ;menghilangkan .dwg
f_out (strcat f_out “csv”) ;ganti extensi menjadi .csv
f (open f_out “w”) ;buka file mode write / tulis
)
(foreach pt Records
(setq
txtID (strcat “cek-” (itoa (nth 0 pt))) ;text id diawali dengan cek-
x (nth 1 pt) ;ambil koord x
y (nth 2 pt) ;nilai y
z 0.0 ;nilai z
pnt3D (vlax-3d-point (list x y z)) ;ubah x y z ke object 3d-point
acadPoint (vla-addpoint mSpace pnt3D) ;buat titik di model space di titik pnt3D
acadText (vla-addtext mSpace txtID pnt3D dTextHeight) ;buat text dengan string=txtID
tulis_ke_csv (strcat ;format csv untuk export koordinat
txtID c ;txtID akhiri dengan delimeted c
(rtos x 2 3) c ;ubah nilai x ke text format 3 digit
(rtos y 2 3) ;ubah nilai y ke text format 3 digit
)
)
(vla-put-layer acadPoint nod_layer) ;object titik diubah ke layer nod_layer
(vla-put-layer acadText nod_layer) ;object titik juga diubah ke layer nod_layer
(vla-put-Alignment acadText acAlignmentCenter) ;set alignment text ke center
(vla-put-TextAlignmentPoint acadText pnt3D) ;set alignment coordinates
(write-line tulis_ke_csv f) ;menulist txtID,x,ya ke file
);next
(close f) ;tutup file karena loop sudah selesai
(command “regen”) ;regen untuk refresh gambar
(setvar “cmdecho” 1) ;kembalikan setting smdecho
(if Records
(alert (strcat “list koordinat disimpan di ” “\n”
f_out))
(alert “Koordinat lengkap”)
)
(princ) ;blank
);akhir program utama
|