Kumpulan Pembelajaran Teknik Sipil

Berbuatlah yang bermanfaat untuk orang lain

Kumpulan AutoLIPS

Posted by handoko10 pada 9 Desember 2008

Memutar garis

; tl is stand for Turn a Line
;        Design by  : Adesu <Ade Suharna>
;        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

;tc is stand for Turn a Circle
;        Design by  : Adesu <Ade Suharna>
;        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

; tat is stand for Turn A Text
;        Design by  : Adesu <Ade Suharna>
;        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

; acf is stand for automatic create fan
;        Design by  : Adesu <Ade Suharna>
;        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 <Ade Suharna>
;        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
; acp is stand for automatic create point
;        Design by  : Adesu &amp;amp;amp;amp;lt;Ade Suharna&amp;amp;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;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
Menampilkan kalender
;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 &amp;
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)
Membuat barcode
;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
)
)

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.
; pwva is stand for Play Winamp Via Autolisp
;        Design by  : Adesu <Ade Suharna>
;        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]<D>: "))) ;1).
(cond ((or (= opt "")(= opt "D"))
(setq opt2
(strcase
(getstring "nSelect your music Dangdut favourite[Campuran,Ike Nurjanah,Rhoma,Uut permatasari]<C>: "))) ; 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]<P>: ")))
(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)
)

Autocad bisa bicara

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

; cas is stand for Create Autocad Speak
;        Design by  : Adesu <Ade Suharna>
;        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

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

 
%d blogger menyukai ini: