(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)
Lisp đầu tiên. Tên lệnh HA.
Sẽ thay đổi tấc cả block thuộc tính. Chọn thuộc tính và nhập chiều cao
;;Thay doi chieu cao thuoc tinh (attributes) Block
;;Viet boi Duong Ba Diep - hochoaivandot
;;www.cadonline.duyxuyen.vn
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
) ;_ end defun
(defun maklis ()
(setq lis_hex '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))
(setq lis_dec '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"))
)
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun 16t10 (hex / lis_hex lis_dec L kt S i j)
(maklis)
(setq L (strlen hex) i L j 0 S 0)
(Repeat L
(setq kt (atoi (nth (vl-position (substr hex i 1) lis_hex) lis_dec)))
(setq S (+ S (* (expt 16 j ) kt)))
(setq i (1- i))
(setq j (1+ j))
)
(itoa S)
)
(defun 10t16 (dec / lis_hex lis_dec hex L dec1 i kt)
(maklis)
(setq dec (fix dec))
(setq hex (strcat))
(setq L (1+ (fix (/ (log dec) (log 16)))) i (1- L) dec1 dec)
(Repeat L
(setq kt (nth (vl-position (itoa (fix (/ dec1 (expt 16 i)))) lis_dec) lis_hex))
(setq hex (strcat hex kt))
(setq dec1 (- dec1 (* (expt 16 i ) (fix (/ dec1 (expt 16 i))))))
(setq i (1- i))
)
hex
)
(defun entback (ena / ena2 han1)
(setq han1 (GET-GC 5 ena))
(setq ena2 (handent (10t16 (- (atof (16t10 han1)) 1))))
)
(defun C:ha (/ *ERROR* ATT conti CURCMD e enn h i na OLDVAL ss tag)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
(t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
) ;_ defun
) ;_ end setq
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nChon ATT muon Edit H: "))) NIL)
(if (= (GET-GC 0 ATT) "ATTRIB")
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq tag (GET-GC 2 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(while (= (GET-GC 0 (setq ATT (entback ATT))) "INSERT")
(setq na (GET-GC 2 ATT))
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 na) (cons 66 1))))
)
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))) conti T)
(setq enn e)
(while conti
(if (and (setq enn (EntNext enn)) (= "ATTRIB" (GET-GC 0 enn)) (= (GET-GC 2 enn) tag))
(progn
(setq conti nil)
(PUT-GC h 40 enn)
)
)
)
)
)
)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ "Viet boi Duong Ba Diep")
(princ)
) ;_ end defun
Lisp thứ 2. Chỉ thay đổi chiều cao 1 thuộc tính trong 1 block. Lisp này cũng có tác dụng với Text và Dim
(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
(t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ)
) ;_ end defun
(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
(t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ)
Mới làm nhanh chưa test. Bạn dùng nếu có gì thì reply mình fix nhé
(defun C:hhh (/ CURCMD ATT OLDVAL TEXT)
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
(t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ)
) ;_ end defun
(setq *ERROR* (defun MY-ERR (MSG)
(cond ((= MSG "Function cancelled") (princ "\t\tUser abort"))
(t (progn (princ MSG) (princ)))
) ;_ end cond
(setq *ERROR* NIL)
(princ)
) ;_ defun
) ;_ end setq
(defun GET-GC (GROUP ENTITY) (cdr (assoc GROUP (entget ENTITY))))
(defun PUT-GC (VALUE GROUP ENTITY / PROPERTIES)
(setq PROPERTIES (entget ENTITY))
(setq PROPERTIES (subst (cons GROUP VALUE) (assoc GROUP PROPERTIES) PROPERTIES))
(entmod PROPERTIES)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
) ;_ end defun
(setq CURCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(while (/= (setq ATT (car (nentselp "\nCh\U+1ECDn thu\U+1ED9c tính \U+0111\U+1EC3 Edit: "))) NIL)
(if (or (= (GET-GC 0 ATT) "ATTRIB")
(= (GET-GC 0 ATT) "TEXT")
(= (GET-GC 0 ATT) "MTEXT")
(= (GET-GC 0 ATT) "DIMENSION")
) ;_ end or
(progn
(setq OLDVAL (GET-GC 40 ATT))
(setq h (getreal (strcat "\Nhap chieu cao chu <" (rtos OLDVAL 2 2) ">:")))
(if (not h) (setq h OLDVAL))
(PUT-GC h 40 ATT)
)
)
) ;_ end while
(setvar "CMDECHO" CURCMD)
(setq *ERROR* NIL)
(princ)
) ;_ end defun