PHẦN MỀM AUTOCAD

admin =  Minh.anviet888

Autolisp

2...Da.lsp (tính tổng khoảng cách một polyline, lệnh = da)

;Running distance calculator by Mike Grisez
(defun c:da (/ pt1 pt2 d)
  (graphscr)
  (setvar "CMDECHO" 0)
  (setq pt1 (getpoint "Pick the First Point "))(terpri)
  (setq pt2 (getpoint "Next Point " pt1))(terpri)
  (setq d (distance pt1 pt2))
  (prompt "Running Distance: ")(prompt (rtos d 4 4))
    (while
    (setq pt1 (getpoint " Next Point: " pt2)) (terpri)
    (setq d (+ (distance pt1 pt2) d))
    (prompt "Running Distance: ")(prompt (rtos d 4 4))
    (setq pt2 pt1)
  )
  (prompt "Total Distance: ")(prompt (rtos d 4 4))
  (princ)
)

1...Ac.lsp (array đối tượng theo 1 kích thước chuẩn, lệnh = ac)

(defun c:ac (/ dt p1 p2 sl index kc goc)
(setq dt (ssget)
p1 (getpoint "\nVao diem goc: ")
p2 (getpoint p1 "\nVao diem den: ")
sl (getint "\nVao so lan: ")
goc (angle p1 p2)
kc (distance p1 p2)
index 0
)
(repeat sl
(setq index (1+ index))
(command ".copy" dt "" p1 (polar p1 goc (* kc index)))
)
)

3...Dchu.lsp (đánh số bậc thanh, lệnh = dchu)

(defun c:dchu1 (/ tdt csht sdt index tt entdt)
(defun thay (tt key moi / cu)
(setq cu (assoc key tt))
(subst (cons key moi) cu tt)
)
(setq tdt (ssget '((0 . "TEXT")))
csht (getint "\nSo bat dau: ")
sdt (sslength tdt)
index 0
)
(repeat sdt
(setq entdt (ssname tdt index)
index (1+ index)
tt (entget entdt)
tt (thay tt 1 (itoa csht))
csht (1+ csht)
)
(entmod tt)
(entupd entdt)
)
(princ)
)

(defun ketthuc ()
(setvar "cmdecho" luuecho)
(setq *error* luu
luu nil
luuecho nil
);setq
(princ "\nThe la het")
(princ)
)
;*******************************************************
(defun modau ()
(setq luu *error
luuecho (getvar "cmdecho")
*error (ketthuc)
)
)
;*******************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq kytu (substr text (strlen text))
ma (ascii kytu)
sokt (read kytu)
lui 1
)
(if (numberp sokt)
(progn
(setq luusokt (1+ sokt))
(if (and (numberp sokt)
(> (strlen text) 1)
)
(progn
(setq kytu (substr text (1- (strlen text)))
sokt (read kytu)
)
(if (numberp sokt)
(setq luusokt (1+ sokt)
lui 2

)
)
);progn
)
(if (= luusokt 100) (setq luusokt 0))
(setq kytu (rtos luusokt 2 0)

text (strcat (substr text 1 (- (strlen text) lui)) kytu)
)
);progn
(if (or (= kytu "z")
(= kytu "Z")
)
(setq text (strcat text "0")
textxl "0"
)
(setq ma (1+ ma)
text (strcat (substr text 1 (1- (strlen text))) (chr ma))
)
);if
);if
)
;*******************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq doituong (entget tendoituong)
kieu (cdr (assoc 0 doituong))
canle (cdr (assoc 72 doituong))
)

(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(progn
(setq textxl (xulytext textxl)
text (cons 1 textxl)
vitri10 (cdr (assoc 10 doituong))
vitri10 (list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
vitri10 (cons 10 vitri10)
vitri11 (cdr (assoc 11 doituong))
vitri11 (list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
vitri11 (cons 11 vitri11)
dem 0
dsach nil
)
(foreach tam doituong
(cond
((= (car tam) 1) (setq dsach (append dsach (list text))))((= (car tam) 10) (setq dsach (append dsach (list vitri10))))
((= (car tam) 11) (setq dsach (append dsach (list vitri11))))
((setq dsach (append dsach (list tam))))
)
)
(entmake dsach)
);progn
);if
);
;*******************************************************
;sao doi tuong cu sang vi tri moi
(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun
;*******************************************************
(defun c:dchu2 ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(setq luuecho (getvar "cmdecho")
luu *error*
*error* ketthuc
cumdt (ssget)
dodai (sslength cumdt)
goc (getpoint "\nSelect base point:")
thoat nil
dem 0
textxl nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while (and (= thoat nil)
(< dem dodai)
)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(setq thoat T
textxl (cdr (assoc 1 doituong))
)
)
);
(if (/= textxl nil)
(while T
(setq toi (getpoint "\nSelect next point: " goc)
vitrilech (list (- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem 0
)
(while (< dem dodai)
(setq ten (ssname cumdt dem)
dem (1+ dem)
doituong (entget ten)
kieu (cdr (assoc 0 doituong))
)
(if (or (= kieu "TEXT")
(= kieu "MTEXT")
)
(doitext ten)
(copy_dt ten)
);if
)
);while
);if
(ketthuc)
);defun
;Note: bien toan cuc: textxl vitrilech

5...lola.lsp (hiệu chỉnh thuộc tính layer, lệnh : "lola = khóa tất cả layer / ula = mở lại tất cả layer

;;;;
"*" = chọn tất cả
"" = enter của bàn phím

;LOCK TẤT CẢ LAYER
(defun C:lola (lock tất cả layer)
(command "-layer" "lock" "*" "")
(princ)
)

;;;;

;UNLOCK TOAN BO LAYER
(defun C:ola (unlock tất cả layer)
(command "-layer" "unlock" "*" "")
(princ)
)

 (if (/= pt ptcu)
      (progn
 (princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
 (setq ptcu pt)
      )
    )
    (if (or (= (tendoituong ssdt) "SPLINE")
     (= (tendoituong ssdt) "LINE")
     (= (tendoituong ssdt) "CIRCLE")
     (= (tendoituong ssdt) "ARC")
     (= (tendoituong ssdt) "POLYLINE")
     (= (tendoituong ssdt) "ELLIPSE")
     (= (tendoituong ssdt) "TEXT")
     (= (tendoituong ssdt) "DIMENSION")
            (= (tendoituong ssdt) "ATTDEF")
     (= (tendoituong ssdt) "SOLID")
     (= (tendoituong ssdt) "INSERT")
     (= (tendoituong ssdt) "ATTRIB")
     (= (tendoituong ssdt) "HATCH")
 )
      (progn
 (setq thongtin (entget ssdt)
       thongtin (suadinh thongtin)
 )
 (entmod thongtin)
      )
    )
    (if (= (tendoituong ssdt) "LWPOLYLINE")
      (progn
        (setq thongtin (entget ssdt)
       thongtin (suadinhPL thongtin)
 )
 (entmod thongtin)
      )
    )
    (princ)
  )
)

6...

;

5...lola.lsp (hiệu chỉnh thuộc tính layer, lệnh : "lola = khóa tất cả layer / ula = mở lại tất cả layer

;;;;;;;;
"*" = chọn tất cả
"" = enter của bàn phím
;;;;;;;;
;LOCK TẤT CẢ LAYER
(defun C:lola (lock tất cả layer)
(command "-layer" "lock" "*" "")
(princ)
)
;;;;;;;;
;UNLOCK TOAN BO LAYER
(defun C:ula (unlock tất cả layer)
(command "-layer" "unlock" "*" "")
(princ)
)