Seputar Vlisp pada cad

Membuat kotak
(DEFUN C:KP (/ dx dy pt1 pt2 pt3 pt4 pt5 pt6 ) ; mebuat kotak dengan input PxL
(setq dx (getreal "Piro dowone joko :"))
(setq dy (getreal "Piro lebare joko :"))
(setq pt1 (getpoint "Nggone neng endi joko :"))
(setq pt2 (list (+(car pt1) dx) (cadr pt1)))
(setq pt3 (list (car pt2) (+(cadr pt1)dy)))
(setq pt4 (list (car pt1) (cadr pt3)))
(command "Pline" pt1 pt2 pt3 pt4 "c"))

Mematikan Layer
(defun C:lk ( / echo ent lyrlk) ; mematikan layer dengan select object
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ent (entsel "\nklik layer seng arep di kunci joko : "))
(if (NULL ent)
(while (NULL ent)
(princ "\n ")
(setq ent (entsel))
)
)
(setq ent (entget (car ent)))
(setq lyrlk (cdr (assoc 8 ent)))
(COMMAND "LAYER" "LOCK" lyrlk "")
(setvar "CMDECHO" echo)
(princ)
)

Membuka Layer Yang terkunci
(defun c:Lb ( / ent lyrun echo) ; membuka kunci layer
(setq echo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ent (entsel "\nKlik layer seng arep bi bukak kuncine joko : "))
(if (null ent)
(while (null ent)
(princ "\n ")
(setq ent (entsel))
)
)
(setq ent (entget (car ent)))
(setq lyrun (cdr (assoc 8 ent)))
(command "layer" "unlock" lyrun "")
(setvar "cmdecho" echo)
(princ)
)

Membuat Busur
(defun c:BUSUR () ; Membuat Busur
(setq bus (car (entsel "\nPilih Tali Busur : ")))
(setq enty (entget bus))
(setq jari (cdr (assoc 40 enty)))
(setq sdt1 (atof (angtos (cdr (assoc 50 enty)) 0 4)))
(setq sdt2 (atof (angtos (cdr (assoc 51 enty)) 0 4)))
(setq sdt3 (- sdt2 sdt1))
(if (< sdt3 0) (setq sdt3 (+ sdt3 360)) sdt3)
(setq hsl (rtos (* (/ sdt3 180) pi jari) 2 2))
(command "dim1" "ang" pause pause hsl "" "")
(princ (strcat "\nPanjang tali busur : " hsl))
(princ)
)

Mengurutkan Angka yang terkecil ke terbesar
(defun c:UrT ()
(setq n1 1)
(setq n2 (getint "\nCacahe Angka Piro : "))
(setq n4 (- n2 1))
(setq ttk (getpoint "\nMulaine ko ngendi : "))
(setq ttk1 ttk)
(setq ttk2 (car ttk1))
(setq ttk3 (caddr ttk1))
(setq sps (getreal "\nJarake piRo : "))
(command "text" ttk1 "" "" n1)
(setq ttk4 ttk1)
(repeat n4
(progn
(setq n3 (+ n1 1))
(setq ttk5 (- (cadr ttk4) sps))
(setq ttk4 (list ttk2 ttk5 ttk3))
(command "text" ttk4 "" "" n3)
)
(setq n1 (+ n1 1))
(setq ttk5 (- (cadr ttk4) sps))
)
)
(defun myerror (s)

(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setq *error* olderr)
(princ)
)

Membuat titik koordinat
(defun c:koor (/ olderr pt1 pt2 pt3 pt4 nam kx ky)
(setq olderr *error*
*error* myerror)
(setvar "cmdecho" 0)
(setq pt1 (getpoint"\nTitike koordinate: " ))
(setq pt2 (getpoint"\nTitik njimuk'e text: "))
(setq nam (getstring"\nJenenge Titik: "))
(setq kx (rtos(car pt1) 2 3))
(setq ky (rtos(cadr pt1) 2 3))
(setq pt3 (list (+ (car pt2) 2) (cadr pt2) (caddr pt2)))
(setq pt4 (list (+ (car pt2) 6) (cadr pt2) (caddr pt2)))
(COMMAND "TEXT" pt2 "" "" nam )
(COMMAND "TEXT" "" kx )
(COMMAND "TEXT" "" ky )
(setq *error* olderr)
(princ)
)

Posted in: komputer