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.
Memutar garis
Sebuah garis akan bergerak atau berputar, bila diolah sedemikian rupa, dengan menggunakan program Autolisp, gunakan program ini anda akan menyaksikan bagaimana sebuah garis akan berputar dengan sendirinya.
; tl is stand for Turn a Line
; Design by : Adesu
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 06 October 2004
; Program no.: 0104/10/2004
; Edit by : Adesu 11/07/2005 1).
; 21/09/2005 2).add clockwise
(defun c:tl (/ ad adr dir p1 p2 n ss cnt ssl ssn)
(setq ad (getvar "angdir")) ; 2).
(cond ((= ad 0)(setq adr "CCW"))
((= ad 1)(setq adr "CW"))
)
(setq dir
(getstring
(strcat "nCOUNTER CLOCKWISE OR CLOCKWISE [CCW/CW]<" adr ">: ")))
(cond ((= dir "")(setvar "angdir" ad))
((= dir "ccw")(setvar "angdir" 0))
((= dir "cw")(setvar "angdir" 1))
)
(while
(setq p1 (getpoint "nCLICK LOCATION FOR START LINE: "))
(setq p2 (getpoint p1 "nCLICK LOCATION FOR END LINE: "))
(if ; 1).
(and p1 p2) ; to check p1 p2 exits
(command "_line" P1 P2 "")
(progn
(alert
(strcat "nYOUR POINT SELECTED INVALID"
"nPLEASE TRY AGAIN"))(exit))
) ; end of if
(setq n 360)
(repeat n
(command "_rotate" "L" "" p1 "1")
) ; end of repeat
(setq ss (ssget "p" '((0 . "LINE"))))
(setq cnt 0)
(setq ssl (sslength ss))
(setq ssn (ssname ss cnt))
(command "_erase" ssn "")
) ; end of while
(princ)
)
Memutar lingkaran
Kliklah di sembarang tempat dan masukan nilai diameter dari sebuah lingkaran, maka lingkaran tersebut akan berputar dengan sendirinya.
;tc is stand for Turn a Circle
; Design by : Adesu
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 06 October 2004
; Program no.: 105/10/2004
; Edit by : Adesu 04/02/2006 1).
(defun c:tc (/ p1 p2 p3 n) ; 1).
(setq p1 (getpoint "nCLICK LOCATION FOR START LINE: "))
(setq p2 (getdist p1 "nENTER DIAMETER OF CIRCLE: ")) ; 1).
(setq p3 (polar p1 0 p2))
(if ; 1).
p2
(command "_circle" P1 P2 "")
(alert (strcat "nInvalid input diameter"
"nPlease try again....type tc"))
)
(setq n 360)
(if ; 1).
p3
(progn
(repeat n
(command "_rotate" "L" "" p3 "1")
) ; repeat
) ; progn
(alert "nInvalid input for base point")
) ; if
(princ)
)
Memutar huruf
Memutar text dengn program Autolisp sangat jarang ditemui, baik di forum maupun di majalah internet, dengan program ini anda bisa mempelajari dan memanipulasi program ini sekehendak anda, coba lakukan perubahan pada variabel tertentu, dan anda akan melihat hasil serta akibat perubahan tersebut.
; tat is stand for Turn A Text
; Design by : Adesu
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 11 September 2006
; Program no.: 0420/09/2006
; Edit by : Adesu 12/09/2006 1).
(defun c:tat (/ cnt el1 el2 loc n p2 sp ss sse ssl ssn str th xa xyp)
(setq loc '(0 0 0))
(setq th 2)
(setq str "Adesu")
(command "_text" loc th "" str 0)
(setq el1 (entlast))
(setq sse (entget el1))
(setq sp (cdr (assoc 10 sse)))
(if
(not (member "geom3d.arx" (arx)))
(arxload "geom3d")
)
(rotate3d el1 "x" sp "r" 0 90)
(setq el2 (entlast))
(command "_vpoint" "r" 315 15 "") ; 1).
(setq p2 '(5 5 0))
(setq n 3600)
(repeat n
(command "_rotate" el2 "" p2 "0.1") ; 1).
) ; repeat
(setq ss (ssget "p" '((0 . "TEXT"))))
(setq cnt 0)
(setq ssl (sslength ss))
(setq ssn (ssname ss cnt))
(command "_erase" ssn "")
(setq xa 270)
(setq xyp 90)
(command "_vpoint" "r" xa xyp "")
(princ)
)
Otomatis membuat kipas
Awalnya penulis hanya iseng ketika membuat program ini, setelah jadi ternyata program ini unik untuk di lihat.
; acf is stand for automatic create fan
; Design by : Adesu
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 26 July 2005
; Program no.: 0257/07/2005
; Edit by : Adesu 04/02/2006 1).
(defun c:acf (/ dia loc rad cnt ang clr lay nlay endp startp
ss ssl cn ssn) ; 1).
(command "_zomm" "v")
(command "_ucsicon" "off")
(setq dia 1)
(setq loc '(0 0 0))
(setq rad (/ dia 2.0))
(setq cnt 0)
(setq ang 0)
(setq clr 1) ; 1).
(setq lay "Automatic_Create_Fan_") ; 1).
(repeat 5
(setq nlay (strcat lay (itoa clr))) ; 1).
(if ; 1).
(not (tblsearch "layer" nlay))
(command "_layer" "m" nlay "c" (itoa clr) "" "")
)
(setq clr (1+ clr)) ; 1).
(setvar "clayer" nlay) ; 1).
(repeat 1000
(setq endp (polar loc (+ cnt ang)(+ cnt rad)))
(setq startp endp)
(setq endp (polar endp (+ cnt ang)(+ cnt rad)) )
(command "line" startp endp "")
(setq ang (1+ ang))
(setq cnt (1+ cnt))
) ; end of repeat
(command "_zoom" "e")
(setq ss (ssget "x"))
(setq ssl (sslength ss))
(setq cn 0)
(repeat ssl
(setq ssn (ssname ss cn))
(command "_erase" ssn "")
(setq cn (1+ cn))
)
)
) ; end of defun
Otomatis membuat garis
Menampilkan seluruh warna yang ada di kode Autocad, dari kode 1 sampai dengan kode 255, ketika sudah berupa garis sangat menarik dan indah, menyerupai gambaran pelangi.
Ketika anda mencoba usahakan set “blipmode” menjadi “off”, pada program ini tidak dilengkapi pasilitas set blipmode.
; acl is stand for automatic create line
; Design by : Adesu
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 26 July 2005
; Program no.: 259/07/2005
; Edit by : Adesu 04/02/2006 1).
(defun dtr (a)
(* pi (/ a 180.0)))
(defun c:acl (/ dia loc ang rad cnt num clr lay nlay spt
ept ss ssl cn ssn)
(command "_zomm" "v")
(command "_ucsicon" "off")
(setq dia 1)
(setq loc '(0 0 0))
(setq ang 0)
(setq rad (/ dia 2.0))
(setq cnt 0)
(setq num 1) ; 1).
(setq clr 1) ; 1).
(setq lay "Automatic_Create_Line_") ; 1).
(repeat 1000
(setq nlay (strcat lay (itoa num))) ; 1).
(if ; 1).
(not (tblsearch "layer" nlay))
(command "_layer" "m" nlay "c" (itoa clr) "" "")
)
(setq clr (1+ clr)) ; 1).
(setq num (1+ num)) ; 1).
(if ; 1).
(> clr 255)
(setq clr 1)
)
(setvar "clayer" nlay) ; 1).
(setq spt (polar loc (dtr ang) rad))
(setq ept (polar loc (dtr (+ cnt ang))(+ cnt rad)))
(command "line" spt ept "")
(setq ang (1+ ang))
(setq cnt (1+ cnt))
) ; end of repeat
(command "_zoom" "e")
(setq ss (ssget "x"))
(setq ssl (sslength ss))
(setq cn 0)
(repeat ssl
(setq ssn (ssname ss cn))
(command "_erase" ssn "")
(setq cn (1+ cn))
) ; end of repeat
) ; end of defun
Otomatis membuat titik
Bentuk yang ditampilkan hampir menyerupai seekor laba-laba, yang sedang membuat jaring dengan cara melingkar, tapi program ini menggunakan aneka warna , dengan aplikasi titik sebagai tampilannya.
; acp is stand for automatic create point
; Design by : Adesu &amp;amp;lt;Ade Suharna&amp;amp;gt;
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 27 July 2005
; Program no.: 260/07/2005
; Edit by : Adesu 04/02/2006 1).
(defun dtr (a)
(* pi (/ a 180.0)))
(defun c:acp (/ dia loc ang rad cnt num clr lay nlay
ept ss ssl cn ssn)
(command "_zomm" "v")
(command "_ucsicon" "off")
(setq dia 1)
(setq loc '(0 0 0))
(setq ang 0)
(setq rad (/ dia 2.0))
(setq cnt 0)
(setq num 1) ; 1).
(setq clr 1) ; 1).
(setq lay "Automatic_Create_Point_") ; 1).
(repeat 1000
(setq nlay (strcat lay (itoa num))) ; 1).
(if ; 1).
(not (tblsearch "layer" nlay))
(command "_layer" "m" nlay "c" (itoa clr) "" "")
)
(setq clr (1+ clr)) ; 1).
(setq num (1+ num)) ; 1).
(if ; 1).
(&amp;amp;gt; clr 255)
(setq clr 1)
)
(setvar "clayer" nlay) ; 1).
(setq ept (polar loc (dtr (+ cnt ang))(+ cnt rad)))
(command "point" ept "")
(setq ang (1+ ang))
(setq cnt (1+ cnt))
) ; end of repeat
(command "_zoom" "e")
(setq ss (ssget "x"))
(setq ssl (sslength ss))
(setq cn 0)
(repeat ssl
(setq ssn (ssname ss cn))
(command "_erase" ssn "")
(setq cn (1+ cn))
) ; end of repeat
) ; end of defun
Tags: Dasar AutoLISP
Tidak ada komentar:
Posting Komentar