Kumpulan Pembelajaran Teknik Sipil

Berbuatlah yang bermanfaat untuk orang lain

Contoh program AutoLIPS

Posted by handoko10 pada 23 Oktober 2008

Contoh Membuat GarisTeknik 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.

Langkah selanjutnya mengeset variabel p1, disini program diset sedemikian rupa, langkah pertama yang muncul di layar monitor, adalah menanyakan kepada user atau pemakai, agar kursor di klik disembarang tempat, dan pada pertanyaan itu terdapat tanda “ <0,0,0> “, yang artinya bila pemakai tidak berkeinginan untuk melakukan proses klik, pemakai hanya dianjurkan menekan tombol enter saja, otomatis variabel p1 itu akan diset ke nilai (0 0 0) berkat bantuan fungsi if, demikian pula pada variabel p2, fungsi kerjanya sama dengan variabel p1, tapi ada satu tambahan setelah fungsi getpoint ditambahkan variabel p1, ini tujuannya agar garis kursor atau rubber band selalu mengikuti kemana arah kursor dialihkan.

Kemudian dengan bantuan fungsi if lagi, memastikan apakah varibel p1 dan p2 masih ada atau eksis , jika hasilnya betul , perintah pembuatan garis dilaksanakan, lantas dilanjutkan dengan perintah pembesaran agar garis tadi yang dibuat bisa terlihat dengan jelas.

Perintah terakhir adalah mengembalikan fungsi seting orthomode ke asal kembali, dan menutup program dengan fungsi princ, agar program keluar dengan tenang.

Membuat Garis

; cmg = contoh membuat garis

(defun c:cmg (/ om p1 p2)

(setq om (getvar “orthomode”))

(if

(/= om 1)

(setvar “orthomode” 1)

) ; if

(setq p1 (getpoint “nDi klik pada sembarang lokasi<0,0,0>: “))

(if (= p1 nil)(setq p1 ‘(0 0 0)))

(setq p2 (getpoint p1 “nDi klik pada sembarang lokasi<10,0,0>: “))

(if (= p2 nil)(setq p2 ‘(10 0 0)))

(if

(and p1 p2)

(command “_line” p1 p2 “”)

) ; if

(command “_zoom” “e”)

(setvar “orthomode” om)

(princ)

) ; defun

Membuat Kotak

Contoh Membuat KotakMembuat kotak bisa dibuat berbagai cara , dengan menggunakan fungsi line akan terbentuk kotak dengan garis individual, dengan fungsi pline membentuk jadi satu entiti, serta dengan fungsi rectangular akan terbentuk jadi satu entiti pula.

; cmk = contoh membuat kotak

(defun c:cmk (/ om p1 p2 p3 p4)

(setq om (getvar “orthomode”))

(if

(/= om 1)

(setvar “orthomode” 1)

) ; if

(setq p1 (getpoint “nDi klik pada sembarang lokasi<0,0,0>: “))

(if (= p1 nil)(setq p1 ‘(0 0 0)))

(setq p2 (getpoint p1 “nDi klik pada sembarang lokasi<10,0,0>: “))

(if (= p2 nil)(setq p2 ‘(10 0 0)))

(setq p3 (getpoint p2 “nDi klik pada sembarang lokasi<10,5,0>: “))

(if (= p3 nil)(setq p3 ‘(10 5 0)))

(setq p4 (getpoint p3 “nDi klik pada sembarang lokasi<0,5,0>: “))

(if (= p4 nil)(setq p4 ‘(0 5 0)))

(command “_pline” p1 p2 p3 p4 “c” “”)

(command “_zoom” “e”)

(setvar “orthomode” om)

(princ)

) ; defun

Membuat Lingkaran

Contoh Membuat LingkaranLingkaran bisa pula dibuat dengan beberapa cara, umumnya dibuat dengan fungsi circle, objek menjadi satu entiti, tapi tidak tertutup kemungkinan bisa dibuat dengan menggunakan point

; cml = contoh membuat lingkaran

(defun c:cml (/ om p1 p2 p3 p4)

(setq om (getvar “orthomode”))

(if

(/= om 1)

(setvar “orthomode” 1)

) ; if

(setq rad (getdist “nMasukan radius lingkaran<5>: “))

(if (= rad nil)(setq rad 5))

(setq p1 (getpoint “nDi klik pada sembarang lokasi<0,0,0>: “))

(if (= p1 nil)(setq p1 ‘(0 0 0)))

(command “_circle” p1 rad “”)

(command “_zoom” “e”)

(setvar “orthomode” om)

(princ)

) ; defun

Membuat Ellips

Contoh Membuat ElipElip adalah lingkaran yang radiusnya tidak sama, maka ada yang bernama radius besar dan radius kecil, elip bisa dibuat dari sebuah lingkaran , dengan trik tertentu maka sebuah lingkaran bisa menjadi sebuah elip

; cme = contoh membuat elip

(defun c:cme (/ om p1 p2 pt)

(setq om (getvar “orthomode”))

(if

(/= om 1)

(setvar “orthomode” 1)

) ; if

(setq minor (getdist “nMasukan jarak terpendek<5>: “))

(if (= minor nil)(setq minor 5))

(setq major (getdist “nMasukan jarak terpanjang<10>: “))

(if (= major nil)(setq major 10))

(setq pt (getpoint “nKlik lokasi untuk elip<0,0,0>: “))

(if (= pt nil)(setq pt ‘(0 0 0)))

(setq p1 (polar pt (* pi 0.5)(/ minor 2.0)))

(setq p2 (polar pt 0 (/ major 2.0)))

(command “_ellipse” pt p1 p2)

(command “_zoom” “e”)

(setvar “orthomode” om)

(princ)

) ; defun

Membuat ARC

Contoh membuat ArcMembuat busur atau arc, dibutuhkan tiga buah titik, yang berupa variabel, sebenarnya untuk membuat arc ada beberapa cara, tetapi disini hanya disajikan yang paling mudah dipelajari.

; cma = contoh membuat arc

(defun c:cma (/ om p1 p2 p3)

(setq om (getvar “orthomode”))

(if

(= om 1)

(setvar “orthomode” 0)

) ; if

(setq p1 (getpoint “nKlik untuk awal arc<0,0,0>: “))

(if (= p1 nil)(setq p1 ‘(0 0 0)))

(setq p2 (getpoint p1″nKlik untuk tengah arc<10,0,0>: “))

(if (= p2 nil)(setq p2 ‘(10 0 0)))

(setq p3 (getpoint p2″nKlik untuk akhir arc<10,10,0>: “))

(if (= p3 nil)(setq p3 ‘(10 10 0)))

(command “_arc” p1 p2 p3 “”)

(command “_zoom” “e”)

(setvar “orthomode” om)

(princ)

) ; defun

Membuat Segi Banyak

Contoh Membuat Segi banyakPoligon atau segi banyak, adalah jumlah sudutnya atau seginya bisa diatur sesuai keinginan pemakai, dan bentuk segi tersebut akan dibentuk diluar atau didalam radius lingkaran, tergantung pilihan dari para pemakainya.

; cmsb = contoh membuat segi banyak

(defun c:cmsb (/ om p1 p2 p3)

(setq om (getvar “orthomode”))

(if

(= om 1)

(setvar “orthomode” 0)

) ; if

(setq jml (getint “nJumlah polygon<6>: “))

(if (= jml nil)(setq jml 6))

(setq opt (strcase (getstring “nPilih Inscribed/Circumscribed: “)))

(cond ((= opt nil)(setq opt “I”))

((= opt “C”)(setq opt “C”))

) ; cond

(setq p1 (getpoint “nJarak radius polygon<0,0,0>: “))

(if (= p1 nil)(setq p1 ‘(0 0 0)))

(setq p2 (getdist p1″nJarak radius polygon<10>: “))

(if (= p2 nil)(setq p2 10))

(command “_polygon” jml p1 opt p2 “”)

(command “_zoom” “e”)

(setvar “orthomode” om)

(princ)

) ; defun

15.7. Contoh membuat Copy

Program ini akan bekerja hanya untuk mendeteksi sebuah lingkaran , dan akan membuat duplikat, serta akan menanyakan kepada pemakai, lokasi dimana diletakannya untuk objek baru.

; cmo = contoh membuat copy

(defun c:cmo (/ bp etyp om opt ss sse ssn)

(if

(setq ss (car (entsel “nPilih satu object lingkaran”)))

(progn

(setq sse (entget ss))

(setq etyp (cdr (assoc 0 sse)))

(if

(= etyp “CIRCLE”)

(progn

(setq bp (cdr (assoc 10 sse)))

(setq opt (getpoint “nPilih lokasi untuk copy<0,0,0>: “))

(command “_copy” ss “” bp opt)

) ; progn

(alert “nObjek bukan lingkaran”)

) ; if

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

(command “_zoom” “e”)

(princ)

) ; defun

15.8. Contoh membuat copy array

Membentuk duplikat ada dua cara, salah satunya bentuk melingkar dan berbaris, dengan program ini kedua-duanya dipakai.

; cmca = contoh membuat copy array

(defun c:cmca (/ column etyp lok opt pitch pitch_column

pitch_row rotasi row ss sse total_polar)

(if

(setq ss (car (entsel “nPilih satu object lingkaran”)))

(progn

(setq sse (entget ss))

(setq etyp (cdr (assoc 0 sse)))

(if

(= etyp “CIRCLE”)

(progn

(setq opt (strcase (getstring “nPilih polar/rectang[P/R]: “)))

(cond

((= opt “P”)

(progn

(setq opt “P”)

(setq total_polar (getint “nJumlah polar<15>: “))

(if (= total_polar nil)(setq total_polar 15))

(setq rotasi (getreal “nSudut putar<360>: “))

(if (= rotasi nil)(setq rotasi 360))

(setq lok (getpoint “nBasis rotasi<0,0,0>: “))

(if (= lok nil)(setq lok ‘(0 0 0)))

(command “_array” ss “” opt lok total_polar rotasi “”)

) ; progn

)

((and (= opt “R”)(= opt “”))

(progn

(setq opt “R”)

(setq row (getint “nJumlah baris<5>: “))

(if (= row nil)(setq row 5))

(setq column (getint “nJumlah kolom<5>: “))

(if (= column nil)(setq column 5))

(setq pitch (getreal “nJarak baris<10>: “))

(if (= pitch_row nil)(setq pitch_row 10))

(setq pitch_column (getreal “nJarak kolom<15>: “))

(if (= pitch_column nil)(setq pitch_column 15))

(command “_array” ss “” opt row column pitch_row pitch_column)

) ; progn

)

) ; cond

) ; progn

(alert “nObjek bukan lingkaran”)

) ; if

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

(command “_zoom” “e”)

(princ)

) ; defun

Membuat Offset

Contoh membuat offsetSebelum menjalankan program ini, buatlah terlebih dahulu sebuah garis, langkah berikutnya akan menanyakan jarak offsetnya yang harus diisi, nilainya bisa bilangan bulat ataupun bilangan real (yang memakai koma), kemudian akan menanyakan dimana lokasi untuk menaruh offsetnya.

; cmo = contoh membuat offset

(defun c:cmo (/ dis etyp pt ss sse)

(if

(setq ss (car (entsel “nPilih satu object garis”)))

(progn

(setq sse (entget ss))

(setq etyp (cdr (assoc 0 sse)))

(if

(= etyp “LINE”)

(progn

(setq dis (getdist “nJarak offset: “))

(setq pt (getpoint “nKlik disebelah garis: “))

(command “_offset” dis ss pt “”)

) ; progn

(alert “nObjek bukan garis”)

) ; if

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

(command “_zoom” “e”)

(princ)

) ; defun

Mirror

Contoh membuat mirrorBuatlah sebuah rectangular atau kotak, disebelah kotak tersebut buat lagi sebuah garis dengan panjang sembarang, lalu jalankan program ini.

; cmm = contoh membuat mirror

(defun c:cmm (/ ep sp ss1 ss2 sse)

(if

(setq ss1 (car (entsel “nPilih satu object”)))

(progn

(if

(setq ss2 (car (entsel “nPilih satu object sebagai referensi”)))

(progn

(setq sse (entget ss2))

(setq sp (cdr (assoc 10 sse)))

(setq ep (cdr (assoc 11 sse)))

(command “_mirror” ss1 ss2 “” sp ep “”)

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

(command “_zoom” “e”)

(princ)

) ; defun

Move

Contoh membuat moveBuatlah sebuah lingkaran dengan diameter bebas, jalankan program ini dan ikuti petunjuknya yang dikeluarkan oleh program ini.

; cmmo = contoh membuat move

(defun c:cmmo (/ bp etyp om opt ss sse ssn)

(if

(setq ss (car (entsel “nPilih satu object lingkaran”)))

(progn

(setq sse (entget ss))

(setq etyp (cdr (assoc 0 sse)))

(if

(= etyp “CIRCLE”)

(progn

(setq bp (cdr (assoc 10 sse)))

(setq opt (getpoint “nPilih lokasi untuk lokasi baru<0,0,0>: “))

(if (= opt nil)(setq opt ‘(0 0 0)))

(command “_move” ss “” bp opt)

) ; progn

(alert “nObjek bukan lingkaran”)

) ; if

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

(command “_zoom” “e”)

(princ)

) ; defun

Trim

Contoh membuat trimBuat garis horizontal, kemudian buat lagi garis bentuk vertikal dengan memotong garis horizontal, kemudian jalankan program ini.

; cmt = contoh membuat trim

(defun c:cmt (/ om opt ss1 ss2)

(if

(and

(setq ss1 (car (entsel “nPilih satu object garis horizontal”)))

(setq ss2 (car (entsel “nPilih satu object garis vertical”)))

) ; and

(progn

(setq om (getvar “osmode”))

(if

(/= om 1)

(setvar “osmode” 1)

) ; if

(setq opt (getpoint “nPilih salah satu ujung garis: “))

(setvar “osmode” om)

(command “_trim” ss1 ss2 “” opt “”)

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

(command “_zoom” “e”)

(princ)

) ; defun

Fillet

Contoh membuat fillet Ikuti langkah sebelumnya, program ini masih ada kaitannya dengan aturan tersebut.

; cmf = contoh membuat fillet

(defun c:cmf (/ f1 f2 om opt)

(setq om (getvar “osmode”))

(if

(/= om 2)

(setvar “osmode” 2)

) ; if

(if

(and

(setq f1 (car (entsel “nPilih satu object garis horizontal”)))

(setq f2 (car (entsel “nPilih satu object garis vertical”)))

) ; and

(progn

(setq opt (getdist “nMasukan radius untuk fillet<1>: “))

(if (= opt nil)(setq opt 1))

(setvar “osmode” om)

(command “_fillet” “r” opt “_fillet” f1 f2 )

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

(command “_zoom” “e”)

(princ)

) ; defun

Extend

Contoh membuat extendDibutuhkan dua buah garis, salah satu berbentuk horizontal, dari kordinat 0,0 sampai dengan 10,0. Buat lagi sebuah garis vertikal dengan kordinat 15,-5 sampai dengan kordinat 15,15. Ujilah program ini, sejauhmana manfaatnya, perhatikan pemakaian fungsi osnap, banyak programmer yang menggunakan fungsi ini , karena osnap banyak sekali manfaatnya untuk digunakan pada program Autolisp.

; cmge = contoh membuat garis extend

(defun c:cmge (/ f2 lst om ss ssn1 ssn2)

(princ “nPilih dua garis object”)

(setq ss (ssget))

(setq ssn1 (ssname ss 0))

(setq ssn2 (ssname ss 1))

(setvar “osmode” 1)

(setq str “nPilih yg mau dipanjangkan”)

(setq f2 (osnap (cadr (entsel str))) “endp”))

(setvar “osmode” 0)

(command “_extend” ssn1 ssn2 “” “e” “e” f2 “”)

(command “_zoom” “e”)

(princ)

) ; defun

Chamfer

Contoh membuat chamferBuatlah garis dari kordinat 0,0 sampai dengan 10,0 dan sambungkan dari kordinat 10,0 sampai dengan 10,15, cobalah program ini anda akan merasakan manfaatnya.

; cmch = contoh membuat chamfer

(defun c:cmch (/ f1 f2 dis)

(setq om (getvar “osmode”))

(if

(/= om 2)

(setvar “osmode” 2)

) ; if

(if

(and

(setq f1 (car (entsel “nPilih garis horizontal”)))

(setq f2 (car (entsel “nPilih garis vertical”)))

) ; and

(progn

(setvar “osmode” om)

(setq dis (getdist “nMasukan jarak untuk chamfer: “))

(command “_chamfer” “d” dis dis “” “_chamfer” f1 f2 “”)

) ; progn

(alert “nObjek tidak terpilih,ulangi”)

) ; if

(princ)

) ; defun

Membuat Calender

Menampilkan kalenderKadangkala ketika kita bekerja, mencari kalender meja ataupun dinding sangat susah, mungkin anda belum punya atau memang belum tersedia, dengan program Autolisp adalah solusinya.

;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)

Membuat Bar code

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

;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

)

)

Memitar Musik

Mendengarkan musikKetika 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

; 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)

)

AutoCAD Bicara

Autocad bisa bicaraBila 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

; 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

Sumber : Tentang CAD[/lang_en]

Sorry, the comment form is closed at this time.

 
%d blogger menyukai ini: