Thứ Hai, 4 tháng 10, 2010

Scale linetype_scale và htach_scale.

Lisp này gồm 2 tiện ích scale rất tiện khi bạn là dân quy hoạch:
+SCLT: Scale tất cả linetypescale của các đối tượng trong vùng chọn theo tỉ lệ nhập vào.
+SCH: Scale tất cả Hatch scale của các đối tượng trong vùng chọn (tự động lọc đối tượng hatch trong vùng chọn) theo tỉ lệ nhập vào.
Bạn copy nội dung và tạo file lisp hay tải file về cũng được!

(defun c:sclt (/)
(if (= tlscl nil)
(setq tlscl1 2.00)
(setq tlscl1 tlscl)
)
(setq
tlscl (GETREAL (strcat "\nBan muon scale linetype bao nhieu lan: <" (rtos tlscl1 2 2) ">"))
)
(if (= tlscl nil)
(setq tlscl tlscl1)
)
(prompt "\nChon doi tuong muon chinh.")
(setq ss (ssget))
(setq c 0)
(setq N (sslength ss))
(while (< c N)
(setq eT (ssname ss c))
(setq e (entget eT))
(setq dtsckt (cdr (assoc 48 e)))
(if (= NIL dtsckt)
(command ".chprop" eT "" "S" tlscl "" "")
(setq dtsc tlsc)
)
(IF (/= NIL dtsckt) (PROGN
(setq dtsc (* (cdr (assoc 48 e)) tlscl))
)
)
(setq e (subst (cons 48 dtsc) (assoc 48 e) e))
(entmod e)
(setq c (1+ c))
)
(command "undo" "end")
(Princ)
)
;;;;;;;;;;;
(defun c:sch (/)
(setvar "CMDECHO" 0)
(command "undo" "be")
(if (= tlsc nil)
(setq tlsc1 2.00)
(setq tlsc1 tlsc)
)
(setq
tlsc (GETREAL (strcat "\nBan muon scale hatch bao nhieu lan: <" (rtos tlsc1 2 2) ">"))
)
(if (= tlsc nil)
(setq tlsc tlsc1)
)
(prompt "\nChon doi tuong muon chinh.")
(setq ss (ssget '((0 . "hatch"))))
(setq c 0)
(SETQ N (SSLENGTH SS))
(while (< c N)
(setq eT (ssname ss c))
(setq e (entget eT))
(setq dtsc (* (cdr (assoc 41 e)) tlsc))
(command "hatchedit" et "p" "" dtsc "")
(setq c (1+ c))
)
(command "undo" "end")
(Princ)
)

1 nhận xét:

  1. cảm ơn bạn nhe. minh khong chắc dã dùng no nhưng minh thấy nó rất hay.
    Mình vào dc nhà bạn thông qua CADviet đó.

    Trả lờiXóa