Program Autolisp untuk lain-lain

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.

[sourcecode language=’cpp’]
;CADENCE
;modified for international versions of AutoCAD – (^v^) CAD Studio sro
;www.cadstudio.cz

(defun CALENDAR (/ mn dy cd cel ar crx cry qu
d c y m ox oy xcl ycl am nd cc loc m0 y0)
; Initial settings and definition of constants.
(setvar “CMDECHO” 0)
(setvar “BLIPMODE” 0)
(setvar “OSMODE” 0)
(setq mn ‘(“JANUARY” “FEBRUARY” “MARCH” “APRIL” “MAY” “JUNE” “JULY”
“AUGUST” “SEPTEMBER” “OCTOBER” “NOVEMBER” “DECEMBER”)
dy ‘(31 28 31 30 31 30 31 31 30 31 30 31)
cd ‘(1 4 4 0 2 5 0 3 6 1 4 6))
(setq cel 1.5 ; Cell size
ar 0.8333 ; Aspect Ratio [to fit into A-size sheet]
crx 0.0 ; lower-left hand Corner Reference
cry 0.0
qu 1) ; QUadrant [0=centered, 1=lower right]
(command “_.Style” “TXA” “romant” “” “0.75” “” “” “” “”) ; for characters
(command “_.Style” “TXB” “romans” “” “0.75” “” “” “” “”) ; for numbers
(setq d (rtos (getvar “CDATE”) 2 0) ; get system date,
c (atoi (substr d 1 2)) ; century,
y (atoi (substr d 3 2)) ; year and
m (atoi (substr d 5 2)) ; month
xcl cel ; Cell size – X
ycl (* ar xcl) ; Cell size – Y
am (strcat (nth (1- m) mn) ” ” (substr d 1 4)) ; set month string,
nd (nth (1- m) dy) ; number of days &
cc (+ (nth (1- m) cd) (- 19 c))) ; month code.
(princ ” Generating calendar for “) (princ am)
(princ “, please wait . .”)
; CALDRAW returns the day-of-the-week and location of the last date.
(setq loc (caldraw qu 0 crx cry xcl ycl m y am nd cc))
; To generate mini calendars for the previous and next months.
(if (or (zerop (car loc)) (> (car loc) 2))
(if (< (cadr loc) (+ crx (* xcl 5.0))) (setq ox (+ crx (* xcl 5.0)) oy (+ cry (* ycl 0.05))) (setq ox crx oy (+ cry (* ycl 4.05)))) (if (< (caddr loc) (+ cry ycl)) (setq ox (+ crx (* xcl 5.0)) oy (+ cry (* ycl 0.05))) (setq ox (+ crx (* xcl (+ (car loc) 1))) oy (+ cry (* ycl 4.05))))) (setq xcl (/ xcl 7.0) ; Cell size - X ycl (* ar xcl)) ; Cell size - Y ; For the previous month: (if (= m 1) ; wrap around if January (setq m0 12 y0 (1- y)) (setq m0 (1- m) y0 y)) (setq am (nth (1- m0) mn) ; set month string, nd (nth (1- m0) dy) ; number of days and cc (+ (- 19 c) (nth (1- m0) cd))) ; month code. (if (minusp y0) (setq y0 99 cc (1+ cc))) ; change of century (CALDRAW 0 1 ox oy xcl ycl m0 y0 am nd cc) ; For the next month: (setq ox (+ ox (* xcl 7.0))) (if (= m 12) ; wrap around if December (setq m0 1 y0 (1+ y)) (setq m0 (1+ m) y0 y)) (setq am (nth (1- m0) mn) ; set month string, nd (nth (1- m0) dy) ; number of days and cc (+ (nth (1- m0) cd) (- 19 c))) ; month code. (if (> y0 99) (setq y0 0 cc (1- cc))) ; change of century
(CALDRAW 0 1 ox oy xcl ycl m0 y0 am nd cc)
(command “_.Zoom” “_E”)
(princ ” . complete.n Save the drawing and use PRPLOT or PLOT.n”)
(princ “nCALENDAR — from A’s Computing Expertise – (609) 772-1309n”)
(princ)
)
; This function actually generates the calendar.
(defun CALDRAW (qflg dflg xo yo xcl ycl mn yr am nd cc
/ WK dw cfx cfy ta re te x y ht i)
(setq WK ‘(“SUN” “MON” “TUE” “WED” “THU” “FRI” “SAT”))
(if (and (= mn 2) (zerop (rem yr 4))) (setq nd 29)) ; leap year corrections
(if (and (zerop (rem yr 4)) (or (= mn 1) (= mn 2)))
(setq cc (1- cc)))
; Compute the day of the week for the 1st; 1=Sun, 0,7=Sat.
(setq dw (rem (+ yr (/ yr 4) 1 cc) 7))
(if (zerop dw) (setq dw 7))
(if (zerop qflg)
(setq cfx 0.0 cfy 0.0 ta “_M”)
(setq cfx (* 0.45 xcl) cfy (* 0.45 ycl) ta “R”))
(setq re (+ xo (* 7.0 xcl)) ; define right edge and
te (+ yo (* 5.5 ycl)) ; top edge of frames
x (+ xo (* 3.5 xcl))) ; To write month,
(command “_.Text” “_S” “TXA”) (command) ; reset Text .Style.
(command “_.Text” “_C” (list x (* te 1.01)) (* xcl 0.3333) “0” am)
; Draw the calender frames.
(if (zerop dflg)(progn ; only for the main calendar
(setq x xo y yo)
(repeat 8 ; draw verticals
(command “_.Line” (list x yo) (list x te) “”)
(setq x (+ x xcl)))
(repeat 6 ; draw horizontals
(command “_.Line” (list xo y) (list re y) “”)
(setq y (+ y ycl)))
(command “_.Line” (list xo te) (list re te) “”) ; draw top edge
(setq x (+ xo (* 0.5 xcl)) ; set values for writing
y (- te (* 0.25 ycl)) ; the days of the week
ht (* ycl 0.25)
i 0)
(repeat 7 ; write days
(command “_.Text” “_M” (list x y) ht “0” (nth i WK))
(setq x (+ x xcl)
i (1+ i))))); IF ZEROP DFLG
(command “_.Text” “_S” “TXB”) (command) ; set Text .Style and
(setq x (+ xo (* (- dw 1.5) xcl) cfx) ; starting point – X
y (- (+ yo (* 4.5 ycl)) cfy) ; starting point – Y
ht (* ycl 0.5) ; text height and
i 0) ; date
(repeat nd ; To write the dates
(setq x (+ x xcl)
i (1+ i))
(if (> x re) ; To go to next row
(setq x (+ xo (* 0.5 xcl) cfx)
y (- y ycl)))
(if (< y yo) ; To go to top row (setq y (- (+ yo (* 4.5 ycl)) cfy))) (command "_.Text" ta (list x y) ht "0" (itoa i))) ; Return the day-of-the-week and the location of the last date. (setq dw (rem (+ (1- dw) nd) 7)) (list dw x y)) ; Execute the program automatically, upon loading. (CALENDAR) [/sourcecode]

Membuat barcode

Barcode sangat berguna untuk mengindentifikasi hasil produk, tetapi tidak sederhana membuat tulisan barcode, dengan program ini, adalah pemecahannya.

[sourcecode language=’cpp’]
;AutoCAD bar code utility
;unknown origin, globalization by Xanadu.cz
(defun makebarsupc (txt)
(setq txt (getcodeupc txt)
cnt 1)
(repeat 7
(setq digit (substr txt cnt 1))
(cond
((and (= codetype 1)
(= digit “0”)
)
(moveover)
)
((and (= codetype 1)
(= digit “1”)
)
(putline)
)
((= digit “1”) (moveover))
((= digit “0”) (putline))
)
(setq cnt (1+ cnt))
)
)
(defun getcodeupc (txt)
(cond
((= txt “0”) (setq txt “0001101”))
((= txt “1”) (setq txt “0011001”))
((= txt “2”) (setq txt “0010011”))
((= txt “3”) (setq txt “0111101”))
((= txt “4”) (setq txt “0100011”))
((= txt “5”) (setq txt “0110001”))
((= txt “6”) (setq txt “0101111”))
((= txt “7”) (setq txt “0111011”))
((= txt “8”) (setq txt “0110111”))
((= txt “9”) (setq txt “0001011”))
)
)

(defun moveover ()
(setq sp (polar sp a1 wid))
)

(defun putline ()
(moveover)
(command “_pline” sp “_w” wid wid (polar sp a2 ht) “”)
)

(defun getchecknum ()
(if(= num1 num2)(setq checknum “0”)(progn
(setq pt1 (+ (atoi (substr num1 2 1))
(atoi (substr num1 4 1))
(atoi (substr num2 1 1))
(atoi (substr num2 3 1))
(atoi (substr num2 5 1))
))
(setq pt2 (+ (atoi (substr num1 1 1))
(atoi (substr num1 3 1))
(atoi (substr num1 5 1))
(atoi (substr num2 2 1))
(atoi (substr num2 4 1))
))
(setq pt1 (itoa(+ pt2 (* 3 pt1))))
(setq checknum (itoa(- 10 (atoi(substr pt1 (strlen pt1) 1)))))
))
)

(defun c:barcode ()
(setvar “blipmode” 0)
(setvar “cmdecho” 0)
(setq syschr “0”)
(setq ht1 (* 0.5 (getvar “dimscale”))
ht2 (* 0.45 (getvar “dimscale”))
wid (* 0.0125 (getvar “dimscale”))
ht ht1)
(initget 1)
(setq sp (getpoint “nBar Code Start Point: “))
(initget 1)
(setq a1 (getangle sp “nAngle for Bar Code: “)
a2 (+ a1 (* 0.5 pi)))
(setq num1 100000
num2 100000)
(while (>= num1 100000)
(initget 7)
(setq num1 (getreal “nFirst Number(five digits): “))
)
(while (>= num2 100000)
(initget 7)
(setq num2 (getreal “nSecond Number(five digits): “))
)
(repeat 8
(moveover)
)
(command “_text” “_j” “_r” (polar (polar sp (+ a2 pi) (* 3 wid)) (+ pi a1)
(* 2 wid)
)
(* 6 wid) a1 syschr
)
(putline)
(moveover)
(putline)
(setq codetype 1)
(makebarsupc syschr)
(setq txpt1 (polar (polar sp (+ a2 pi) (* 3 wid)) a1 (* 2 wid)))
(setq sp (polar sp a2 (* 4 wid))
ht ht2
num1 (rtos num1 2 0)
numcnt 1)
(while (< (strlen num1) 5) (setq num1 (strcat "0" num1)) ) (repeat 5 (makebarsupc (substr num1 numcnt 1)) (setq numcnt (1+ numcnt)) ) (setq sp (polar sp (+ pi a2) (* 4 wid)) ht ht1) (setq txpt2 (polar (polar sp (+ a2 pi) (* 3 wid)) (+ pi a1) wid)) (moveover) (putline) (moveover) (putline) (moveover) (setq txpt3 (polar (polar sp (+ a2 pi) (* 3 wid)) a1 wid)) (setq sp (polar sp a2 (* 4 wid)) ht ht2 codetype 2 num2 (rtos num2 2 0) numcnt 1) (while (< (strlen num2) 5) (setq num2 (strcat "0" num2)) ) (repeat 5 (makebarsupc (substr num2 numcnt 1)) (setq numcnt (1+ numcnt)) ) (setq ht ht1 sp (polar sp (+ pi a2) (* 4 wid))) (setq txpt4 (polar (polar sp (+ a2 pi) (* 3 wid)) (+ pi a1) wid)) (getchecknum) (makebarsupc checknum) (putline) (moveover) (putline) (command "_text" "_j" "_f" txpt1 txpt2 (* 6 wid) num1) (command "_text" "_j" "_f" txpt3 txpt4 (* 6 wid) num2) (command "_text" (polar (polar sp (+ a2 pi) (* 3 wid)) a1 (* 2 wid)) (* 6 wid) a1 checknum ) ) [/sourcecode]

Mendengarkan musik

Ketika anda bekerja di depan monitor selama berjam-jam, ini akan membuat diri anda menjadi bosan dan jenuh, konsentrasi akan semakin berkurang, hasil pekerjaan menjadi tidak karuan, ketelitian gambar taruhannya, sebaiknya anda mulai alihkan kejenuhan anda untuk mendengarkan musik, kesayangan anda.
Rubahlah variabel “ file “, dimana kumpulan lagu-lagu kesayangan anda disimpan,  selamat mencoba.

[sourcecode language=’cpp’]
; pwva is stand for Play Winamp Via Autolisp
;        Design by  : Adesu
;        Email      : mteybid@yuasabattery.co.id
;        Homepage   : http://www.yuasa-battery.co.id
;        Create     : 07 February 2007
;        Program no.: 0527/02/2007
;        Edit by    : Adesu  08/02/2007   1).
;                            19/02/2007   2).

(defun c:pwva (/ file file_name fn lst opt opt1 opt2 winamp)
(setq file “D:/YBI/General/Music/”)
(setq opt
(strcase
(getstring “nSelect your music favourite[Dangdut,Instrument,Keroncong,Pop,West]: “))) ;1).
(cond ((or (= opt “”)(= opt “D”))
(setq opt2
(strcase
(getstring “nSelect your music Dangdut favourite[Campuran,Ike Nurjanah,Rhoma,Uut permatasari]: “))) ; 2).
(cond
((or (= opt2 “”)(= opt2 “C”))(setq file “D:/YBI/General/Music/Dangdut/Campuran/”))
((= opt2 “I”)(setq file “D:/YBI/General/Music/Dangdut/Ike Nurjanah/”))
((= opt2 “R”)(setq file “D:/YBI/General/Music/Dangdut/Rhoma/”))
((= opt2 “U”)(setq file “D:/YBI/General/Music/Dangdut/Uut Permatasari/”))
)              ; cond
)
((= opt “I”)(setq file “D:/YBI/General/Music/Instrument/”))
((= opt “K”)(setq file “D:/YBI/General/Music/Keroncong/”))
((= opt “P”)
(setq opt1
(strcase
(getstring “nSelect your music Pop favourite[Dlloyd,Panbers]

: “)))
(cond
((or (= opt1 “”)(= opt1 “P”))(setq file “D:/YBI/General/Music/Pop/Panbers/”))
((= opt1 “D”)(setq file “D:/YBI/General/Music/Pop/Dlloyd/”))
)              ; cond
)
((= opt “W”)(setq file “D:/YBI/General/Music/West/Elvis Presley/”))
)                 ; cond 1).
(if
(setq lst (cddr (vl-directory-files file)))
(progn
(foreach x lst
(setq file_name (strcat file x))
(setq fn (append fn (list file_name)))
)
(setq fn (vl-string-trim “()” (vl-princ-to-string fn)))
(setq winamp “C:/Program Files/Winamp/winamp.exe”)
(startapp winamp fn)
)                    ; progn
(alert “nInvalid,there is not selected file”)
)                      ; if
(princ)
)
[/sourcecode]

Autocad bisa bicara

Bila anda mau menjalankan program ini, terlebih dahulu hubungkan earphone ke tempat colokan atau jack,  atau hidupkan aktif speaker.

[sourcecode language=’cpp’]
; cas is stand for Create Autocad Speak
;        Design by  : Adesu
;        Email      : mteybid@yuasabattery.co.id
;        Homepage   : http://www.yuasa-battery.co.id
;        Create     : 15 February 2007
;        Program no.: 0534/02/2007
;        Edit by    :
;        Idea from  : Terry Cadd

(defun c:cas (/ def speak sapi)
(setq def “Hello Boss,how are you,I am fine and thanks”)
(if
(setq speak (getstring t (strcat “nType word <" def "> : “)))
(progn
(if
(= speak “”)
(setq speak def)
)           ; if
(setq sapi (vlax-create-object “Sapi.SpVoice”))
(vlax-invoke sapi “Speak” speak 0)
(vlax-release-object sapi)
)             ; progn
)               ; if
(princ)
)                 ; defun
[/sourcecode]

  • http://www.erwin4rch.wordpress.com erwin

    Wow! Saya baru lihat AutoLISP seperti ini.
    Amazing…
    Thx 4 sharing with us. :D

  • misu

    wah kereeeeeeeeeeeeeeen

  • dadang

    mas saya mau tanya nih, tapi salam kenal dulu
    kalo untuk menjalankan programnya atau animasi dari Autolispnya gimana yach

  • muhammad ashar

    ada autolisp untuk program jalan nggak yaa.. klo ada bisa dibagi-bagi donk….makasih