Menampilkan kalender

Kadangkala ketika kita bekerja, mencari kalender meja ataupun dinding sangat susah, mungkin anda belum punya atau memang belum tersedia, dengan program Autolisp adalah solusinya. [Read more...]

Animasi adalah suatu gambar yang bisa digerakan dengan sendirinya, atau dengan bantuan program tertentu, sebuah gambar bisa bergerak sesuai keinginan pembuatnya, biasanya gambar animasi diperuntukan untuk  pertunjukan kepada orang lain, atau sebagai hiburan.
Dengan bantuan program Autolisp sebuah gambar bisa menjadi gambar animasi, penulis sisipkan enam buah program animasi, agar pembaca bisa mempelajari manfaat setiap fungsi yang dipakai. [Read more...]

Pada bagian ini penulis sengaja menyisipkan, beberapa program yang sudah jadi, hasil karya penulis sendiri dan diantaranya ada yang sudah pernah ditampilkan di beberapa forum autolisp. Bisa anda lihat pada kolom keterangan ada beberapa nama orang lain yang penulis cantumkan, bahwa program tersebut pada kolom editnya, tercantum orang yang pernah berjasa, mengoreksi pada tanggal tertentu dan fungsi tertentu.

——————————————————————————–

Edit
Edit Warna
Merubah warna sebuah objek, bisa dilakukan dengan program ini, ketika program menanyakan warna apa yang akan diubah, masukan warna objek dengan nilai angka.

Usahakan bila memasukan angka untuk warna, tidak mengenal koma, kode angka untuk warna selalu digunakan bilangan interger, dari kode 1 sampai dengan 255. Jika anda memasukan angka bernilai ada komanya, coba anda lakukan modifikasi supaya pemakai tidak selalu keliru, pada program ini masih ada kekeliruan, yaitu masih tetap menggunakan fungsi getreal.

[sourcecode language='cpp']
; ec is stand for Edit Color
; Design by : Adesu < Ade Suharna>
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 7 October 2004
; Program no.: 0107/10/2004
; Edit by : Adesu 09/03/2007 1). all format

(defun c:ec (/ col ent opt ss vevo)
(vl-load-com)
(while
(setq ss (car (entsel “nSelect an object”)))
(setq vevo (vlax-ename->vla-object ss))
(setq col (vla-get-color vevo))
(setq opt (getreal (strcat “nEnter new color< " (itoa col) " >: “)))
(vlax-put vevo ‘color (fix opt))
) ; while
(princ)
) ; defun
[/sourcecode]

Edit Diameter Lingkaran
Lingkaran yang dibutuhkan adalah sebanyak 10 buah, buat dengan bermacam- macam diameter, gunakan rumus kode ini.
Manfaat fungsi while akan terasa, untuk mengulang program menjadi otomatis, nilai angka yang dimasukan bisa berupa bilangan real ataupun interger.

[sourcecode language='cpp']
; edc is stand for Edit Diameter Circle
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 24 September 2004
; Program no.: 85/09/2004
; Edit by : Ade Suharna 14/01/2005 1).

(defun c:edc (/ ss ssn en ent opt)
(while
(vl-load-com)
(prompt “nSELECT A CIRCLE”) ; 1).
(setq ss (ssget)) ; 1).
(setq ssn (ssname ss 0)) ; 1).
(setq en (vlax-ename->vla-object ssn))
(setq ent (rtos (vlax-get-property en “diameter”)))
(setq opt (getreal (strcat “nENTER NEW VALUE FOR DIAMETER <" ent "> : “)))
(vla-put-diameter en opt)
)
(princ)
)
[/sourcecode]

Edit dimensi tinggi huruf
Pekerjaan yang membosankan adalah, ketika harus merubah dimensi dengan jumlah banyak, kalau ada dimensi sebanyak 100 buah atau lebih, yang dirubah hanyalah ukuran tinggi textnya saja. Berarti akan ada 100 kali pengerjaan yang diulang, bila pekerjaan ini dilakukan dengan cara manual, akan menguras tenaga dan waktu.

Dengan mengunakan program ini, sekali dijalankan, seluruh objek yang menggunakan dimensi text akan dikerjakan hanya dalam hitungan detik, cukup singkat dan banyak membantu pekerjaan anda.

[sourcecode language='cpp']
; edth is stand for Edit Dimension Text Height
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 24 January 2007
; Program no.: 0513/01/2007
; Edit by :
(defun c:edth (/ cnt opt ss ssl ssn th vevo)
(setq ss (ssget “x” ‘((0 . “DIMENSION”))))
(setq ssl (sslength ss))
(setq cnt 0)
(setq opt (getreal “nEnter new text height<1>: “))
(if (= opt nil)(setq opt 1))
(repeat
ssl
(setq ssn (ssname ss cnt))
(setq vevo (vlax-ename->vla-object ssn))
(setq th (vlax-get vevo ‘TextHeight))
(vlax-put vevo ‘TextHeight opt)
(vlax-Release-Object vevo)
(setq cnt (1+ cnt))
) ; repeat
(princ)
) ; defun
[/sourcecode]

Edit warna objek
Program ini judulnya hampir sama dengan “Edit warna”, tetapi fungsinya akan lain, bila warna objek di set ke “by layer”, dengan menggunakan kode “Edit Color”, objek tersebut tidak akan bisa berubah, hanya dengan program ini objek tersebut bisa dimodifikasi.

[sourcecode language='cpp']
; eoc is stand for Edit Object Color
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 24 February 2006
; Program no.: 329/02/2006
; Edit by :
(defun c:eoc (/ ss sse sf cur veo tc ci att opt el sse_el sf_el veo1 tc1 ci1)
(if
(setq ss (car (entsel “nSelect a object”)))
(progn
(setq sse (entget ss))
(setq sf (cdr (assoc 62 sse)))
(if
sf
(setq cur (itoa sf))
(progn
(vl-load-com)
(setq veo (vlax-ename->vla-object ss))
(setq tc (vlax-get-property veo ‘TrueColor))
(setq ci (vlax-get-property tc ‘ColorIndex))
(setq cur (itoa ci))
) ; progn
) ; if
(setq att “nEnter new value of color”)
(while
(setq opt
(fix
(getreal
(strcat att ” <" cur ">: “)))) ; check if user put value and hit
; enter,program would repeat again.
; if user only hit enter the program
; would stop
(cond ((= opt nil)(setq sf sf))
((/= opt nil)(setq sf opt)))
(command “_change” ss “” “p” “c” sf “”)
(setq el (entlast))
(setq sse_el (entget el))
(setq sf_el (cdr (assoc 62 sse_el)))
(if
sf
(setq cur (itoa sf))
(progn
(vl-load-com)
(setq veo1 (vlax-ename->vla-object ss))
(setq tc1 (vlax-get-property veo ‘TrueColor))
(setq ci1 (vlax-get-property tc ‘ColorIndex))
(setq cur (itoa ci))
) ; progn
) ; if
) ; while
) ; progn
(alert “nInvalid selected object,please try again”)
) ; if
(princ)
)
[/sourcecode]

Edit hanya huruf
Sebuah program yang sederhana untuk mengedit sebuah kalimat atau text, program ini pernah dimuat di sebuah forum, untuk minta bantuan koreksi, salah satu anggota forum yang bernama Tn. Rudy Tovar yang telah berjasa merevisi sebagian program.
Program ini khusus menggunakan fungsi “errno”, yang akan mendeteksi bila objek yang dipilih hasilnya nihil, maka fungsi errno akan memberitahukan.

[sourcecode language='cpp']
; eto is stand for Edit Text Only
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 11 August 2004
; Program no.: 0048/08/2004
; Edit by : Ade Suharna 17/09/2004 1).
; 05/10/2004 2). was disappeared
; 07/03/2005 3).
; Rudy Tovar 08/03/2005 4).
; Adesu 23/03/2006 5). making edit text -> edit text only
; Adesu 18/12/2006 6).

(defun c:eto (/ e en ent opt ed)
(while ; 6).
(setq e (entsel “nSELECT TEXT”)) ; 4).
(if
e
(= (getvar “errno”) 7)
(alert “nINVALID CHOOSE,PLEASE TRY AGAIN”)
) ; 3).
(setq en (entget (car e)))
(setq ent (cdr (assoc 1 en)))
(setq opt
(getstring T (strcat “nENTER NEW TEXT” “<" ent ">: “))) ; 1).
(setq ed (subst (cons 1 opt)(assoc 1 en) en))
(entmod ed)
) ; while
(princ)
) ; defun
[/sourcecode]

Menghapus
Menghapus semua objek
Bila anda malas melakukan penghapusan objek yang berada di area gambar, karena objeknya terlalu banyak, gunakan program ini, program ini sangat membantu sekali.

[sourcecode language='cpp']
; eao is stand for Erase Alls Object
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 27 January 2005
; Program no.: 0171/01/2005
; Edit by : Ade Suharna 08/03/2005 1).

(defun c:eao (/ ss ssl cnt ssn)
(setq ss (ssget “x”))
(setq ssl (sslength ss)) ; 1).
(setq cnt 0) ; 1).
(repeat ssl ; 1).
(setq ssn (ssname ss cnt)) ; 1).
(command “_erase” ssn “”)
(setq cnt (1+ cnt)) ; 1).
)
(princ)
)
[/sourcecode]

Menghapus semua layer
Tidak terbayangkan kalau gambar anda ada sekitar 10000 layer, dan anda berkeinginan menghapus semuanya, berapa lama waktu yang dibutuhkan untuk pekerjaan itu, serta akan terasa pegal jari tangan anda ketika melakukannya.

Tapi berkat bantuan program ini semua layer yang berada diarea gambar, akan dihapus dengan cepat, hanya membutuhkan beberapa saat, untuk pekerjaan ini, anda akan menghemat waktu, pekerjaan menjadi ringan.

[sourcecode language='cpp']
; easl is stand for Erase AllS Layer
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 8 June 2005
; Program no.: 236/06/2005
; Edit by : Adesu 08/08/2005 1).
; 04/02/2006 2).
; 23/03/2006 3). eal -> easl
(defun Table (s / d r) ; by Michael Puckett
(while
(setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r)))
)

(defun c:easl (/ ss cnt ssl ssn lay n cnt nlay)
(setvar “clayer” “0″) ; 1).
(setq ss (ssget “x”)) ; 1).
(if ; 2).
ss
(progn
(setq cnt 0) ; 1).
(setq ssl (sslength ss)) ; 1).
(repeat ssl ; 1).
(setq ssn (ssname ss cnt)) ; 1).
(command “_erase” ssn “”) ; 1).
(setq cnt (1+ cnt)) ; 1).
) ; repeat
(setq lay (table “layer”)) ; 2).
(setq n (length lay)) ; 2).
(setq cnt 0) ; 2).
(repeat n ; 2).
(setq nlay (nth cnt lay))
(command “_purge” “la” nlay “y” “y” “”)
(setq cnt (1+ cnt))
) ; repeat
) ; progn
(progn ; 2).
(setq lay (table “layer”))
(setq n (length lay))
(setq cnt 0)
(repeat n
(setq nlay (nth cnt lay))
(command “_purge” “la” nlay “y” “y” “”)
(setq cnt (1+ cnt))
) ; repeat
) ; progn
) ; if
(princ) )
[/sourcecode]

Menghapus berdasarkan warna
Gambar yang banyak menggunakan aneka warna, dan betuk serta jenis garis, termasuk ukuran, tersebar di beberapa layer yang tidak diketahui, dengan jelas. Hal ini akan merepotkan bila kita ingin menghapus salah satu warna, dengan program ini, mengatasi masalah sudah bukan rintangan lagi.

Anda cukup memasukan data warna apa yang akan dihapus, semua objek yang anda inginkan akan terhapus dengan cepat.

[sourcecode language='cpp']
; ebc is stand for Erase By Color
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 18 January 2005
; Program no.: 166/01/2005
; Edit by :

(defun c:ebc (/ ob ss)
(while
(setq ob (fix (getreal “nENTER VALUE COLOR: “)))
(setq ss (ssget “x” (list (cons 62 ob))))
(command “_erase” ss “”)
)
(princ)
)
[/sourcecode]

Mengukur
Untuk membuat program banyak cara dilakukan oleh para programmer, diantaranya program untuk mengukur objek, dibawah ini ada tiga buah program hasil kreasi penulis pada saat awal membuat program.

Mengukur panjang garis
Mengukur panjang suatu objek garis, sebenarnya cukup dilakukan satu kali pengambilan objek, yaitu dengan bantuan fungsi entsel, dari data ini bisa diuraikan awal dan akhir dari objek garis.

Penulis dengan sengaja menampilkan, sebuah program hasil karya penulis, pada saat awal baru bisa membuat program, agar para pembaca bisa mempelajari teknik dan trik cara membuat program itu.

[sourcecode language='cpp']
; mll is stand for measuring length of a line
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 6 June 2004
; Program no.: 0034/06/2004
; Edit by : Edit by TCEBob7/6/2004 1).

(defun c:mll (/ adot-1 adot-2 alin bdot-1 bdot-2 blin dist_ab)
(setq alin (entget (car (entsel “Please choose start line: “)))) ;1)
(setq adot-1 (assoc 10 alin)) ;1)
(setq adot-2 (cdr adot-1))
(setq blin (entget (car (entsel “Please choose end line: “)))) ;1)
(setq bdot-1 (assoc 11 blin)) ;1)
(setq bdot-2 (cdr bdot-1))
(setq dist_ab (distance adot-2 bdot-2))
(prompt “nLENGTH OF LINE: “)
(princ dist_ab)
(princ)
)
[/sourcecode]

Mengukur sebuah lingkaran
Penyajian data bisa dilakukan beberapa cara, salah satunya ditampilkan lewat dialog box atau alert box, seperti yang di contohkan program di bawah ini. Program ini mengukur sebuah objek yang berupa lingkaran, disajikan dengan alert box, meliputi jenis objek, nilai radius serta lokasi objek diarea gambar.

[sourcecode language='cpp']
; mac is stand for Measuring A Circle
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 29 September 2004
; Program no.: 0094/09/2004
; Edit by : Adesu 19/07/2006 alls

(defun c:mac (/ rad sp ss sse typ x y z)
(setq ss (car (entsel “nCLICK OF OBJECT”)))
(if
ss
(progn
(setq sse (entget ss))
(setq typ (cdr (assoc 0 sse)))
(setq rad (rtos (cdr (assoc 40 sse)) 2 3))
(setq sp (cdr (assoc 10 sse)))
(setq x (rtos (car sp) 2 3))
(setq y (rtos (cadr sp) 2 3))
(setq z (rtos (caddr sp) 2 3))
(alert (strcat “nThis object is = ” typ
“nRadius of circle is = ” rad
“nLocation of base point is = ”
x ” , ” y ” , ” z))
) ; progn
(alert “nInvalid selected object,please try again”)
) ; if
) ; defun
[/sourcecode]

Mengukur sebuah elip
Program ini hampir sama dengan program “mengukur sebuah lingkaran”. Disini ditampilkan radius jarak terpendek dan radius jarak terpanjang dari elip itu, prinsip pengerjaannya sama seperti datas tadi.

[sourcecode language='cpp']
; mae is stand for Measuring A Ellipse
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 29 September 2004
; Program no.: 0095/09/2004
; Edit by : Adesu 19/07/2006 alls
; 27/11/2006 1). me -> mae

(defun c:mae (/ ep epx epy epz rat sp spx spy spz ss sse typ)
(setq ss (car (entsel “nCLICK OF OBJECT”)))
(if
ss
(progn
(setq sse (entget ss))
(setq typ (cdr (assoc 0 sse)))
(setq rat (rtos (cdr (assoc 40 sse)) 2 3))
(setq sp (cdr (assoc 10 sse)))
(setq spx (rtos (car sp) 2 3))
(setq spy (rtos (cadr sp) 2 3))
(setq spz (rtos (caddr sp) 2 3))
(setq ep (cdr (assoc 11 sse)))
(setq epx (rtos (car ep) 2 3))
(setq epy (rtos (cadr ep) 2 3))
(setq epz (rtos (caddr ep) 2 3))
(alert (strcat “nThis object is = ” typ
“nRatio Minor to Major is = ” rat
“nMajor axis is = ” epx epy epz
“nLocation of base point is = ” spx spy spz))
) ; progn
(alert “nInvalid selected object,please try again”)
) ; if
)
[/sourcecode] ; defun

Mencari
Mencari objek diarea gambar bukan perkara ringan, bila yang dicari adalah objek yang sulit terlihat, dan karena objeknya banyak, hal ini akan menjadi suatu tantangan bagi siapa saja yang melakukannya. Sebagai pemecahan problem ini lebih baik dibuatkan sebuah program, yang diantaranya telah ada program yang sudah jadi.

Mencari titik awal objek
Program ini akan mencari setiap objek, yang didapat dari hasil tangkapan kursor, dengan bantuan fungsi entsel dan menguraikannya, sehingga didapat “base point” atau dengan kode dxf adalah 10, dari kode 10 tersebut akan diuraikan kordinat untuk “x” dan “y’” serta nilai “z” nya.

[sourcecode language='cpp']
; ses is stand for Search Entity Start
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 31 August 2004
; Program no.: 59/08/2004
; Edit by : Ade Suharna 21/09/2004

(defun c:ses (/ ent1 ent2 xpoint ypoint)
(setq ent1 (entget (car (entsel “nSELECT LINE: “))))
(setq ent2 (cdr (assoc 10 ent1)))
(setq xpoint (rtos (car ent2)2 3))
(setq ypoint (rtos (cadr ent2) 2 2))
(alert (strcat “nStart point of X = ” ” ” xpoint
“nStart point of Y = ” ” ” ypoint))
(princ)
)
[/sourcecode]

Mencari nama layer
Program ini sangat sederhana, dan sangat pendek serta gampang dipelajari, tidak terlalu banyak menggunakan fungsi lain, ini sangat cocok untuk bahan pelajaran bagi para pemula.

[sourcecode language='cpp']
; sln is stand for Searching of Layer Name
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 7 January 2005
; Program no.: 0159/01/2005
; Edit by :

(defun c:sln (/ ob lay nlay)
(while
(setq ob (entget (car (entsel “nSELECT OBJECT: “)))
lay (cdr (assoc 8 ob))
nlay (alert (strcat “nTHIS LAYER IS <" lay ">“)))
)
(princ)
)
[/sourcecode]

Set
Perlakuan set bisa dilakukan terhadap berbagai macam variabel ataupun command, model sudut pandang dan termasuk set terhadap layer.

Set semua layer hidup
Penulis pernah menghadapi masalah, ketika ingin melakukan seting supaya layer hidup semua, sementara jumlah layer yang ada sekitar dua ratus buah, tentu saja ini membuat malas bekerja, karena melakukan pekerjaan yang terus menerus secara kontinyu, terbesit pemikiran bagaimana kalau dibuatkan sebuah program, yang akan meringankan pekerjaan itu.

Dengan mengandalkan kemampuan penulis membuat program, maka sekitar bulan Agustus 2005, mulai dilakukan proyek pembuatan khusus program untuk pekerjaan set.

[sourcecode language='cpp']
; slon is stand for Set Layer ON
; Design by : Adesu
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 09 August 2005
; Program no.: 0268/08/2005
; Edit by : Adesu 21/11/2006 1). clon -> slon

(defun Table (s / d r) ; by Michael Puckett
(while
(setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r)))
)

(defun c:slon (/ tbl len cnt nlay)
(setq tbl (table “layer”))
(setq len (length tbl))
(setq cnt 0)
(repeat len
(setq nlay (nth cnt tbl))
(command “_layer” “on” nlay “”)
(setq cnt (1+ cnt))
) ; end of repeat
(princ)
)
[/sourcecode]

Set pandangan pada plan
Ketika anda melakukan seting sudut pandang, untuk mendapatkan sudut pandang yang nyaman, dan mendapatkan posisi yang bagus, khususnya untuk pandangan pada objek 3 dimensi, tetapi saat akan kembali ke posisi semula, anda mendapat kesulitan dan mungkin lupa tempat setingan di letakkan.

Dengan program ini langkah kerja anda menjadi lebih singkat, cukup ketik kode “spv” pada command prompt, dan lanjutkan dengan tekan enter, seketika sudut pandang akan berubah.

Atau mungkin ingin seting yang khusus, rubahlah variabel “xa” dan xyp”, sesuai keinginan anda.

[sourcecode language='cpp']
; spv is stand for set to plan view
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 08 October 2005
; Program no.: 294/12/2005
; Edit by
(defun c:spv (/ xa xyp)
(setq xa 270)
(setq xyp 90)
(command “_vpoint” “r” xa xyp “”)
(command “_zoom” “e”)
(princ)
)
[/sourcecode]

Set semua layer mati
Program ini sama dengan “Set semua layer hidup”, hanya beda berupa kebalikannya. Program ini otomatis bila proses telah selesai, langsung di set ke layer 0.

[sourcecode language='cpp']
; slof is stand for Set Layer OFf
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 09 August 2005
; Program no.: 0269/08/2005
; Edit by : Adesu 21/11/2006 1). clof -> slof

(defun Table (s / d r) ; by Michael Puckett
(while
(setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r)))
)

(defun c:slof (/ tbl len cnt nlay)
(setvar “clayer” “0″)
(setq tbl (table “layer”))
(setq len (length tbl))
(setq cnt 0)
(repeat len
(setq nlay (nth cnt tbl))
(if (= nlay “0″)(setvar “clayer” (car tbl)))
(command “_layer” “off” nlay “”)
(setq cnt (1+ cnt))
) ; end of repeat
(princ)
)
[/sourcecode]

Menampilkan
Memperlihatkan dan menyembunyikan objek dengan sebuah program, perlu trik khusus, karena bila tidak tahu cara yang tepat, bisa-bisa anda kebingungan sendiri, objek hilang entah kemana.

Menampilkan dan menghilangkan objek
Objek bisa dihilangkan ataupun dimunculkan kembali, gunakan program ini, anda akan merasakan sejauh mana manfaat program ini untuk aktifitas kerja anda.

[sourcecode language='cpp']
; saho is stand for Show And Hide of Object
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 28 April 2006
; Program no.: 0362/04/2006
; Edit by
(defun c:saho (/ sh ss opt)
(initget “S s H h”)
(setq sh (getkword “nSelect Show or Hide [s/h]: “))
(if (= sh nil)(setq sh “H”))
(cond
((= sh “S”)
(progn
(setq ss (ssget “x”))
(setq ss (ssname ss 0))
(setq opt 1)
(redraw ss opt)
) ; progn
)
((= sh “H”)
(progn
(setq ss (car (entsel “nSelect a object”)))
(setq opt 2)
(redraw ss opt)
) ; progn
)
) ; cond
(princ)
) ; defun
[/sourcecode]

Huruf
Membuat text sebenarnya sederhana dan mudah, tetapi bila seorang pengguna menginginkan ada kelainan, maksudnya mungkin membuat text secara individual ataupun otomatis membuat baris kebawah.

Hal ini membuat text menjadi tidak sederhana lagi, dan memerlukan keahlian khusus, disinilah letak seorang programmer untuk membuktikan keahliannya, sesuai keinginan pemakai cad tersebut.

Huruf diatas garis
Garis yang diletakan dibawah text, umumnya bikinan seorang programmer, karena tuntutan dari gambar yang sedang dikerjakannya, biasanya Autocad versi tertentu belum dilengkapi kapasitas untuk membuat hal tersebut.

Penulis lampirkan sebuah program untuk membuat sebuah text, kemudian secara otomatis dibuat garis dibawah text tersebut.

[sourcecode language='cpp']
; tal is stand for create Text Above Line
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 31 March 2005
; Program no.: 222/03/2005
; Edit by :

(defun c:tal (/ osm om txs loc tex th ss ssn sse gap tb xl p1 p2)
(setq osm (getvar “osmode”))
(setq om (getvar “orthomode”))
(setvar “osmode” 64)
(setvar “orthomode” 1)
(setq txs (getvar “textstyle”))
(if (/= txs “standard”)
(setvar “textstyle” “standard”))
(while
(setq loc (getpoint “nCLICK LOCATION FOR OBJECT: “))
(setq tex (getstring t “nENTER NEW TEXT: “))
(setq th (getdist “nENTER TEXT HEIGHT: “))
(command “_text” loc th “” tex “”)
(setq ss (ssget loc))
(setq ssn (ssname ss 0))
(setq sse (entget ssn))
(setq gap (* th 0.2))
(setq tb (textbox sse))
(setq xl (car (nth 1 tb)))
(setq p1 (polar loc (* Pi 1.5) gap))
(setq p2 (polar p1 0 xl))
(command “_line” p1 p2 “”)
)
(princ)
(setvar “osmode” 64)
(setvar “orthomode” om)
)
[/sourcecode]

Huruf dirubah ke angka
Program ini berfungsi untuk merubah dari sebuah kalimat, menjadi untaian deretan angka, sebagai contoh bila kalimat “Adesu” diuji dengan rumus ini, maka kalimat tersebut akan berubah menjadi “65 100 101 115 117″.

[sourcecode language='cpp']
; ttn is stand for Text To Number
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 19 October 2004
; Program no.: 0116/10/2004
; Edit by : Adesu 16/10/2006 1). remove setvar
; 17/10/2006 2). revised alls format

(defun condi (tx / )
(cond ((= tx “A”)(setq num “65″))
((= tx “B”)(setq num “66″))
((= tx “C”)(setq num “67″))
((= tx “D”)(setq num “68″))
((= tx “E”)(setq num “69″))
((= tx “F”)(setq num “70″))
((= tx “G”)(setq num “71″))
((= tx “H”)(setq num “72″))
((= tx “I”)(setq num “73″))
((= tx “J”)(setq num “74″))
((= tx “K”)(setq num “75″))
((= tx “L”)(setq num “76″))
((= tx “M”)(setq num “77″))
((= tx “N”)(setq num “78″))
((= tx “O”)(setq num “79″))
((= tx “P”)(setq num “80″))
((= tx “Q”)(setq num “81″))
((= tx “R”)(setq num “82″))
((= tx “S”)(setq num “83″))
((= tx “T”)(setq num “84″))
((= tx “U”)(setq num “85″))
((= tx “V”)(setq num “86″))
((= tx “W”)(setq num “87″))
((= tx “X”)(setq num “88″))
((= tx “Y”)(setq num “89″))
((= tx “Z”)(setq num “90″))
((= tx “a”)(setq num “97″))
((= tx “b”)(setq num “98″))
((= tx “c”)(setq num “99″))
((= tx “d”)(setq num “100″))
((= tx “e”)(setq num “101″))
((= tx “f”)(setq num “102″))
((= tx “g”)(setq num “103″))
((= tx “h”)(setq num “104″))
((= tx “i”)(setq num “105″))
((= tx “j”)(setq num “106″))
((= tx “k”)(setq num “107″))
((= tx “l”)(setq num “108″))
((= tx “m”)(setq num “109″))
((= tx “n”)(setq num “110″))
((= tx “o”)(setq num “111″))
((= tx “p”)(setq num “112″))
((= tx “q”)(setq num “113″))
((= tx “r”)(setq num “114″))
((= tx “s”)(setq num “115″))
((= tx “t”)(setq num “116″))
((= tx “u”)(setq num “117″))
((= tx “v”)(setq num “118″))
((= tx “w”)(setq num “119″))
((= tx “x”)(setq num “120″))
((= tx “y”)(setq num “121″))
((= tx “z”)(setq num “122″)))
num
) ; defun

(defun c:ttn (/ fs lst sp ss sse ssn str tf th tj tx xtx)
(setq ss (ssget ‘((0 . “MTEXT,TEXT”))))
(setq ssn (ssname ss 0))
(setq sse (entget ssn))
(setq str (cdr (assoc 1 sse)))
(setq sp (cdr (assoc 10 sse)))
(setq th (cdr (assoc 40 sse)))
(setq fs (cdr (assoc 41 sse)))
(setq tf (cdr (assoc 71 sse)))
(setq tj (cdr (assoc 72 sse)))
(setq lst (mapcar ‘chr (vl-string->list str)))
(foreach x lst
(setq tx (condi x))
(setq xtx (append xtx (list tx)))
) ; foreach
(setq xtx (vl-string-trim “()” (vl-princ-to-string xtx)))
(command “_erase” ss “”)
(entmake (list ‘(0 . “TEXT”)
‘(100 . “AcDbEntity”)
‘(100 . “AcDbText”)
(cons 1 xtx)
(cons 10 sp)
(cons 40 th)
(cons 41 fs)
(cons 71 tf)
(cons 72 tj)))
(princ)
) ; defun
[/sourcecode]

Huruf di tambah
Menambah huruf pada huruf yang sudah jadi, agak merepotkan terutama dengan tampilnya dialog box, kadangkala untuk menampilkan dialog box, ada yang suka bermasalah, tampilan dialog box ukurannya cukup besar, ini akan mengganggu luas pandang pemakai itu sendiri.

Menampilkan hanya perintah yang akan di edit, sebuah trik yang cukup simpel dan sederhana, proses kerja menjadi lebih pendek.

[sourcecode language='cpp']
; tad is stand for Text ADd
; Design by : Adesu < Ade Suharna >
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 10 September 2004
; Program no.: 0065/09/2004
; Edit by : Ade Suharna 06/10/2004 1).not recorded
; Adesu 27/11/2006 2).ta -> tad

(defun c:tad (/ ent info1 opt ed)
(while
(setq ent (entget (car (entsel “nCLICK TEXT FOR EDIT:”))))
(setq info1 (cdr (assoc 1 ent)))
(setq opt (getstring (strcat “nENTER NEW TEXT” “<" info1 ">” “: “)))
(setq ed (subst (cons 1 (strcat info1 ” ” opt))(assoc 1 ent) ent))
(entmod ed)
)
(princ)
)
[/sourcecode]

Contoh Membuat Garis

Teknik menggambar yang paling dasar adalah membuat garis, garis harus dibuat dari awal tujuan sampai ke akhir tujuan, contoh dibawah ini memperlihatkan sebuah program membuat garis, dengan bantuan fungsi seting “orthomode “ agar didapat kedudukan kursor hanya pada posisi horizontal atau vertikal, sebelum program ini bekerja seting orthomode harus diubah ke nilai satu, dengan bantuan fungsi “if”, akan memberikan alternative jika seting orthomode telah diset ke nilai satu, maka fungsi if ini tidak akan bekerja, tetapi bila seting orthomode itu selain nilai 1, maka fungsi if akan bekerja dan langsung diset ke angka 1. [Read more...]