;*******************************************************
;***CAC HAM DUNG CHUNG***
;
;;;Cac ham doi do
;;Chuong trinh doi <do.phutgiay> thanh chuoi ki tu.
;Ham luu giu gia tri do, phut, giay voi 3 bien do, phut, giay
(defun gocstr (ang / ph goc)
(setq do (fix ang)
ph (* (- ang do) 100.0)
phut (fix (+ ph 0.0001))
giay (* (- ph phut) 100.0))
(setq d (rtos do 2 0)
p (if (< phut 10) (strcat "0" (rtos phut 2 0)) (rtos phut 2 0))
g (if (< giay 10.0) (strcat "0" (rtos giay 2 0)) (rtos giay 2 0)))
(setq goc (strcat d "%%d" p "'" g "\""))
goc
)
;;; Chuong trinh doi <do.phutgiay> sang radian
(defun gocrad (goc / ph phut giay do)
(setq do (fix goc))
(setq ph (* (- goc do) 100.0))
(setq phut (fix (+ ph 0.0001)))
(setq giay (* (- ph phut) 100.0))
(setq goc (+ (/ (+ (* phut 60.0) giay) 3600.0) do))
(setq goc (/ (* goc pi) 180))
goc
)
;Doi so lieu goc dang radian sang <do.phutgiay>
(defun radgoc (a / do b phut giay)
(setq a (* (/ a pi) 180))
(setq do (float (fix a)))
(setq b (* (- a do) 60))
(setq phut (float (fix b)))
(setq giay (* (- b phut) 60))
(+ do (/ phut 100.0) (/ giay 10000.0))
)
;;;Doi so lieu goc dang do/thap phan sang <do.phutgiay>
(defun deggoc (a)
(setq do (float (fix a)))
(setq b (* (- a do) 60))
(setq phut (float (fix b)))
(setq giay (* (- b phut) 60))
(+ do (/ phut 100.0) (/ giay 10000.0))
)
;Doi radian sang do/thap phan
(defun raddeg (a)
(* (/ a pi) 180))
;Doi do/thap phan sang radian
(defun degrad (a)
(* a (/ Pi 180)))
;Doi <do.phutgiay> sang do/thap phan
(defun gocdeg(goc / ph phut giay do)
(setq do (fix goc))
(setq ph (* (- goc do) 100.0))
(setq phut (fix (+ ph 0.0001)))
(setq giay (* (- ph phut) 100.0))
(setq goc (+ (/ (+ (* phut 60.0) giay) 3600.0) do))
goc)
;;chuong trinh lay tu dau tien trong chuoi ki tu (khong ke chuoi trong ben trai)
;(wordstr " a b c is string") = "a"
(DEFUN wordstr (str / index find)
(setq index 1)
(setq find (substr str index 1))
(while (= find " ")
(setq index (1+ index))
(setq find (substr str index 1))
)
(fststr (substr str index))
)
;;chuong trinh lay tu dau tien trong chuoi ki tu (Ke ca chuoi trong ben trai)
;(Fststr " a b c is string") = " a"
(DEFUN Fststr (str / index find)
(setq index 1)
(setq find (substr str index 1))
(while (= find " ")
(setq index (1+ index))
(setq find (substr str index 1))
)
(while
(and (/= find " ") (<= index (strlen str)))
(setq find (substr str index 1))
(setq index (1+ index))
)
(if (= find " ")
(setq find (substr str 1 (- index 2)))
str
)
)
;;chuong trinh lay tu dau tien trong chuoi ki tu (Ke ca chuoi trong ben trai)
;va them vao 9 khoang trong ben phai
;(Fst " a b c is string") = " a "
(DEFUN Fst (str / index find)
(setq index 1)
(setq find (substr str index 1))
(while (= find " ")
(setq index (1+ index))
(setq find (substr str index 1))
)
(while
(and (/= find " ") (<= index (strlen str)))
(setq find (substr str index 1))
(setq index (1+ index))
)
(if (= find " ")
(setq str (substr str 1 (1- index)))
str
)
(setq str (substr (strcat str " ") 1 10))
)
;;; Doi list sang chuoi ki tu
;(lstring '(1 2 3)) : " 1 2 3"
(defun lstring (ds / i n str a)
(setq i 0 n (length ds) str " ")
(while (< i n)
(setq a (rtos (nth i ds) 2 3))
(setq str (strcat str " " a))
(setq i (1+ i))
)
str
)
;Luu va tra bien he thong
(defun luuBHT ()
(setq
cmec (getvar "cmdecho")
blip (getvar "blipmode")
clayer (getvar "clayer")
textst (getvar "textstyle")
os (getvar "osmode")
ortho (getvar "orthomode")
)
)
(defun traBHT ()
(setvar "cmdecho" cmec)
(setvar "blipmode" blip)
(setvar "clayer" clayer)
(setvar "textstyle" textst)
(setvar "osmode" os)
(setvar "orthomode" ortho)
)
;Ham chon mot so tren man hinh
;Chon object
(defun chon1so (/ chon ketqua)
(setq chon nill)
(while
(or
(null (setq Chon (car (entsel))))
(/= "TEXT" (cdr (assoc 0 (entget Chon ))))
(null (numberp (distof (cdr (assoc 1 (entget chon))))))
)
(princ "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng, ho\U+1EB7c kh\U+00F4ng ph\U+1EA3i l\U+00E0 text, ho\U+1EB7c kh\U+00F4ng ph\U+1EA3i l\U+00E0 1 s\U+1ED1.\n")
)
(setq TextTP (cdr (assoc 1 (entget Chon))))
(setq sochon chon)
(setq ketqua (distof TextTP))
)
;Ham chon mot so tai diem cho truoc
;chon getpoint
;Dung cho ham tinh cao do trung binh o
(defun chonso (point / P chon ketqua)
(setq P point)
(if
(or
(null (setq Chon (car (nentselp P))))
(/= "TEXT" (cdr (assoc 0 (entget Chon ))))
(null (numberp (distof (cdr (assoc 1 (entget chon))))))
)
(progn
(princ "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng, ho\U+1EB7c kh\U+00F4ng ph\U+1EA3i l\U+00E0 text, ho\U+1EB7c kh\U+00F4ng ph\U+1EA3i l\U+00E0 1 s\U+1ED1.\n")
(setq chon nil)
)
(progn
(setq TextTP (cdr (assoc 1 (entget Chon))))
(setq sochon chon)
(setq ketqua (distof TextTP))
)
)
)
;Tra ve mot so thuc (giong tgetd)
(defun tgetreal (/ sothuc)
(if (null (setq sothuc (getreal ))) (chon1so) sothuc)
)
;Ham chon mot chu
(defun chon1chu (/ chon)
(setq chon nill)
(while
(or
(null (setq Chon (car (entsel))))
(/= "TEXT" (cdr (assoc 0 (entget chon))))
)
(princ "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng, ho\U+1EB7c kh\U+00F4ng ph\U+1EA3i l\U+00E0 text.\n")
)
(setq chuchon chon)
(setq TextTP (cdr (assoc 1 (entget chon)))))
;Ham chon mot canh
;Tra ve mot danh sach ket qua gom 4 toa do cua hai diem xac dinh canh
;P11 P12 ListPt archive
(defun Tselect (/ P1 L1 L2 P3 P01 P02 P03 P2)
(if (null (setq P1 (getpoint "\nSelect from point : ")))
(progn
(while
(or (null (setq L1 (entsel "\nSelect line : ")))
(/= (cdr (assoc 0 (entget (car L1)))) "LINE")
)
(princ "\nNot line : ")
);end while
(if (null L1)
(setq P11 '() P12 '())
(progn
(setq L2 (entget (car L1)))
(setq P3 (cadr L1))
(setq P01 (cdr (assoc 10 L2))
P02 (cdr (assoc 11 L2)))
(setq P03 (polar P01 (angle P01 P02) (/ (distance P01 P02) 2)))
(if (<= (distance P01 P3) (distance P01 P03))
(setq P11 P01 P12 P02)
(setq P11 P02 P12 P01)
);end if
);end progn
);end if
);end progn (then if is closed)
(progn
(initget 1)
(setq P2 (getpoint P1 "\nSelect to point : "))
(setq P11 P1 P12 P2)
);end progn (else if is closed)
);end if
(setq ListPt (list P11 P12)));end defun
;Tra ve do dai mot canh /tuong tu ham getdist cua
lisp(defun Tgetd (/ Thu)
(if (null (setq Thu (getreal "Enter distance : ")))
(progn (Tselect) (setq Canh (distance P11 P12)))
(setq Canh (* Thu (/ 500.0 (getvar "userr1"))))))
;Tra ve mot phuong vi canh /tuong tu getangle
(defun Tgeta (/ Thu)
(if (null (setq Thu (getreal "\nEnter angle : ")))
(progn (Tselect) (setq Goc (Angle P11 P12)))
(setq Goc (degrad (gocdeg Thu)))))
;Tao lop theo danh sach di kem
(defun taolop (dslop)
(mapcar '(lambda (a) (if (null (tblsearch "layer" a))(command "layer" "N" a ""))) dslop)
)
;Ham xac dinh tinh chat cua doi tuong
(defun Fcode_Ent (Ent Fcode / Eg L1 L2 KQ)
(setq KQ nil)
(setq Eg (Entget Ent))
(setq L1 '("type" "value" "Blockname" "dimstyle" "handle" "layer" "color")
L2 '(0 1 2 3 5 8 62)
)
(mapcar '(lambda (a b)
(if (= Fcode a)
(setq KQ (cdr (assoc b Eg)))
)
)
L1 L2)
KQ
)
;Lay gia tri Handle cua doi tuong
(defun Handle (Ent) (cdr (assoc 5 (entget Ent))))
;Tra ve doi tuong theo Handle
(defun Ent_handle (Handle) (handent Handle))
;---------------------------------------
;Lam doi tuong nhap nhay
(defun blink (Entities solan)
(repeat solan
(redraw Entities 2)
(command "delay" 1)
(redraw Entities 1)
(command "delay" 1)
(redraw Entities 3)
(command "delay" 1)
(redraw Entities 4)
)
)
;---------------------------------------
;Doi so thuc sang chuoi (giong rtos)
;VD (trtos 1.05 3) -> "1.050"
(defun trtos (Num dec)
(setq HSLT dec)
(setq N0 (+ Num 0.000000001))
(setq N1 (- N0 (fix N0)))
(setq N2 (rtos N1 2 HSLT))
(setq N3 (- (strlen N2) 2))
(setq them0 ".")
(setq them1 "")
(if (>= N3 HSLT)
(setq CHU (rtos N0 2 HSLT))
(if (= N3 -1)
(setq CHU (strcat (rtos N0 2 HSLT)
(if(= HSLT 0)
(setq them0 "")
(repeat HSLT (setq them0 (strcat them0 "0")))
)
)
)
(setq CHU (strcat (rtos N0 2 HSLT)
(repeat (- HSLT N3) (setq them1 (strcat them1 "0")))
)
)
); end if
);end if
CHU
)
;******************************************************************************
;Loc lay cac doi tuong theo tinh chat cua doi tuong mau
(defun c:Loc (/ LOC1 LOC2 KDT LAY COR LTYP CACHLOC OBJ)
(luuBHT)
(setvar "osmode" 0)
(while (null (setq LOC1 (car (entsel "\nCh\U+1ECDn 1 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng l\U+00E0m m\U+1EABu l\U+1ECDc"))))
(princ "\nKhong co doi tuong."))
(setvar "cmdecho" 1) (setvar "blipmode" blip) (setvar "osmode" os)
(setq LOC2 (entget Loc1))
(setq KDT (cdr (assoc 0 LOC2)))
(setq LAY (cdr (assoc 8 LOC2)))
(if (null (assoc 62 LOC2)) (setq COR 256) (setq COR (cdr (assoc 62 LOC2))))
(if (null (assoc 6 LOC2)) (setq LTYP "BYLAYER") (setq LTYP (assoc 6 LOC2)))
(initget "Kieu Lop Mau Dangduong")
(setq CACHLOC (getkword "\nChon cach loc theo: Kieu,Lop,Mau,Dangduong <K L M D Enter>"))
(cond
((= "Kieu" CACHLOC) (sssetfirst nil (setq OBJ (ssget (list (cons 0 KDT))))))
((= "Lop" CACHLOC) (sssetfirst nil (setq OBJ (ssget (list (cons 8 LAY))))))
((= "Mau" CACHLOC) (sssetfirst nil (setq OBJ (ssget (list (cons 62 COR))))))
((= "Dangduong" CACHLOC) (sssetfirst nil (setq OBJ (ssget (list (cons 6 LTYP))))))
(t (sssetfirst nil
(setq OBJ (ssget (list (cons 0 KDT) (cons 8 LAY) (cons 62 COR) (cons 6 LTYP))))
)))
(traBHT)
(princ))
;******************************************************************************
;Thuc hien lenh acad theo mot so tieu chuan loc
(defun c:Tai (/ LENH KIEU OBJ)
(setvar "cmdecho" 0)
(initget 1 "Move Rotate Copy Scale CHange Mirror Erase")
(setq LENH (getkword "\nMove Rotate Copy Scale CHange Mirror Erase ? <M R C S CH MI E> "))
(initget 1 "Point Line Text LWpolyline All")
(setq KIEU (getkword "\nPoint Line Text LWpolyline All ? <P L T LW A>"))
(if (= KIEU "All")
(while (null (setq OBJ (ssget))))
(while (null (setq OBJ (ssget (list (cons 0 KIEU)))))))
(command LENH OBJ "")
(setq OBJ nil)
(setvar "cmdecho" 1)
(princ))
;******************************************************************************
;tach chu va so ra cac lop rieng biet
(defun c:chu_so (/ SS1 LopT LopN Count En Eg)
(luuBHT)
(setvar "cmdecho" 0)(setvar "osmode" 0)(setvar "blipmode" 0)(setvar "orthomode" 0)
(princ "\nChon cac chu ")
(while (null (setq SS1 (ssget (list (cons 0 "Text")))))(princ "\nCh\U+01B0a ch\U+1ECDn \U+0111\U+01B0\U+1EE3c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng"))
(if (= (setq LopT (getstring "\nNh\U+1EADp t\U+00EAn c\U+00E1c l\U+1EDBp s\U+1EBD t\U+1EA1o ch\U+1EEF: ")) "")(setq LopT "Tamchu"))
(if (= (setq LopN (getstring "\nNh\U+1EADp t\U+00EAn c\U+00E1c l\U+1EDBp s\U+1EBD t\U+1EA1o s\U+1ED1: ")) "")(setq LopN "Tamso"))
;(taolop '(LopT LopN))
(setq Count 0)
(repeat
(sslength SS1)
(setq En (ssname SS1 Count))
(setq Eg (entget En))
(if (numberp (distof (cdr (assoc 1 eg))))
(setq Eg (subst (cons 8 lopN) (assoc 8 Eg) Eg))
(setq Eg (subst (cons 8 LopT) (assoc 8 Eg) Eg))
)
(setq Count (1+ Count))
(entmod Eg)
)
(traBHT)
(princ))
;******************************************************************************
;Tach lay chu co so bat dau
(defun c:chu_coso (/ SS1 LopT Count En Eg)
(luuBHT)
(setvar "cmdecho" 0)(setvar "osmode" 0)(setvar "blipmode" 0)(setvar "orthomode" 0)
(princ "\nChon cac chu ")
(while (null (setq SS1 (ssget (list (cons 0 "Text")))))(princ "\nCh\U+01B0a ch\U+1ECDn \U+0111\U+01B0\U+1EE3c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng"))
(if (= (setq LopT (getstring "\nNh\U+1EADp t\U+00EAn c\U+00E1c l\U+1EDBp s\U+1EBD ch\U+1EE9a ch\U+1EEF")) "")(setq LopT "Chu co so dau"))
;(taolop '(LopT))
(setq Count 0)
(repeat
(sslength SS1)
(setq En (ssname SS1 Count))
(setq Eg (entget En))
(if (not (numberp (distof (cdr (assoc 1 eg)))))
(if (numberp (distof (substr (cdr (assoc 1 eg)) 1 1)))
(setq Eg (subst (cons 8 lopT) (assoc 8 Eg) Eg))
)
)
(setq Count (1+ Count))
(entmod Eg)
)
(traBHT)
(princ))
http://www.cadviet.com/upfiles/3/lisp_loc_layer.lsp
Tue Apr 09, 2024 11:15 am by 
Tiêu đề: Lisp lọc đối tượng theo màu - lệnh loc 
