Jump to content
InfoFile
Tác giả: anhGeodesy
Bài viết gốc: 431020
Tên lệnh: vk
Lisp Vê khung ban đồ địa hình

Vào lúc 3/11/2018 tại 09:57, thanhmicco đã nói:

KHÔNG BIẾT NÓI GÌ...

>>
Vào lúc 3/11/2018 tại 09:57, thanhmicco đã nói:

KHÔNG BIẾT NÓI GÌ HƠN, XIN CẢM ƠN BẠN NHÉ

@thanhmicco

Tôi sửa lại chút Lisp Vẽ khung của Duân để khi Pick điểm trái trên xong thì xuất hiện sợi dây thun để chọn điểm Dưới Phải.=> dễ quan sát

(Alert (strcat "\n Ch\U+01B0\U+01A1ng tr\U+00ECnh t\U+1EA1o khung b\U+00ECnh \U+0111\U+1ED3"
        "\n H\U+00E3y g\U+00F5 l\U+1EC7nh VK \U+0111\U+1EC3 ch\U+1EA1y ch\U+01B0\U+01A1ng tr\U+00ECnh"
        "\n Ng\U+01B0\U+1EDDi vi\U+1EBFt: Ad Nguy\U+1EC5n Thi\U+00EAn \U+0110\U+01B0\U+1EDDng"
       )
)
(Prompt (strcat "\n Ch\U+01B0\U+01A1ng tr\U+00ECnh t\U+1EA1o khung b\U+00ECnh \U+0111\U+1ED3"
        "\n H\U+00E3y g\U+00F5 l\U+1EC7nh VK \U+0111\U+1EC3 ch\U+1EA1y ch\U+01B0\U+01A1ng tr\U+00ECnh"
        "\n Ng\U+01B0\U+1EDDi vi\U+1EBFt: Ad Nguy\U+1EC5n Thi\U+00EAn \U+0110\U+01B0\U+1EDDng"
       )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;TAO WBLOCK MAT LUOI KHUNG NGHIENG ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:Vk( / olmode P1 P2 Tleebd)
(vl-load-com)
(setq olmode (getvar "OSMODE"))
(setvar "OSMODE" 1)
(setq P1 (getpoint "\n Ch\U+1ECDn \U+0111i\U+1EC3m tr\U+00E1i tr\U+00EAn => "))
(setq P2 (getpoint P1 "\n Ch\U+1ECDn \U+0111i\U+1EC3m ph\U+1EA3i d\U+01B0\U+1EDBi => "))
(or *Tleebd* (setq *Tleebd* 1000))
(setq Tleebd (getreal (strcat "\n \n Nh\U+1EADp t\U+1EF7 l\U+1EC7 b\U+1EA3n \U+0111\U+1ED3   <"
          (rtos *Tleebd* 2 0)
         "> :"
      )
 )
)
(if (not Tleebd) (setq Tleebd *Tleebd*) (setq *Tleebd* Tleebd))
(TML1 P1 P2 Tleebd)
(setvar "OSMODE" olmode)
(princ)
)

(defun TML1 (P1 P22 tile_tmp /  Ent Height rau tHeight len_per ob ) ;;;; Tao mat luoi
(vl-load-com)

(setq olmode (getvar "OSMODE"))
(setvar "Osmode" 1)
(setq Height (abs (- (cadr P1) (cadr P22))))
(or #tile (setq #tile 500))
(if tile_tmp (setq #tile tile_tmp))
(setq dis (/ #tile 10.0)
        rau (/ #tile 200.0)
        tHeight  (/ (* 2 rau) 5)
        len_per (/ #tile 100.0)
)
(setq WithLine (* 2 (/ rau 5)))
(setq olmode (getvar "OSMODE"))
(setvar "Osmode" 0)
(setq P11 (list (car P1) (cadr P22)))
(setq
      Gocxoay (angle P11 P22)
      Kc (distance P11 P22)
      P3 (polar P11 (+ (/ pi 2) Gocxoay) Height)
      P4 (polar P3  Gocxoay  Kc)
)
(command "Pline" P11 P3 P4 P22 P11 "")
(setq e (entlast))
(setq Elast (entlast))
(vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p2)
(mapcar  '(lambda (a b ) (* 0.5 (+ a b )))
(setq p1 (vlax-safearray->list p1)) (setq p2(vlax-safearray->list p2)))
(setq x1 (car p1) x2 (car p2) y1 (cadr p1) y2 (cadr p2) y1_tmp (round+ y1 dis) x1_tmp (round+ x1 dis))
;;; DoX
(while (< y1_tmp y2)
    (setq objLine (ST:Entmake-Line (list x1 y1_tmp) (list x2 y1_tmp)))
    (setq y1_tmp (+ y1_tmp dis)
        lstInter (ST:Ent-IntersObj (entlast) e)
        lstInter (vl-sort lstInter '(lambda (x y) (< (car x)(car y))))
        1st  (car lstInter)
            2nd  (cadr lstInter)
    )
    ;Trai
    (ST:Entmake-Line 1st (mapcar '- 1st (list (* 2 rau) 0 0)))
    (wtxt (substr (rtos (cadr 1st) 2 0) 1 4) (list (- (+ (car 1st) WithLine) (* 2 rau)) (+ (cadr 1st) (/ rau 10))) tHeight 0 "L")
      (wtxt  (substr (rtos (cadr 1st) 2 0) 5) (list (- (car 1st) (/ rau 10)) (- (cadr 1st) (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TR")
    ;Phai
    (ST:Entmake-Line 2nd (mapcar '+ 2nd (list (* 2 rau) 0 0)))
    (wtxt (substr (rtos (cadr 2nd) 2 0) 1 4) (list (car 2nd) (+ (cadr 2nd) (/ rau 10))) tHeight 0 "L")
      (wtxt  (substr (rtos (cadr 2nd) 2 0) 5) (list (+ (- (car 2nd) WithLine) (* 2 rau)) (-  (cadr 2nd)  (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TR")
 
    (ST:GGBP (car lstInter) (cadr lstInter) dis len_per)                
    (entdel objLine)
;;Do sth else        
)
(ST:Entmake-Line P11 (list (- (car P11) (* 2 rau)) (cadr P11)))
(ST:Entmake-Line P11 (list (car P11) (- (cadr P11) (* 2 rau)) ))

(ST:Entmake-Line P22 (list (+ (car P22) (* 2 rau)) (cadr P22)))
(ST:Entmake-Line P22 (list (car P22) (- (cadr P22) (* 2 rau)) ))

(ST:Entmake-Line P4 (list (+ (car P4) (* 2 rau)) (cadr P4)))
(ST:Entmake-Line P4 (list (car P4) (+ (cadr P4) (* 2 rau))))

(ST:Entmake-Line P3 (list (- (car P3) (* 2 rau)) (cadr P3)))
(ST:Entmake-Line P3 (list (car P3) (+ (cadr P3) (* 2 rau)) ))
;;;;;;;;GHI TOA DOA Y 2314678.789
      ;Tay Nam
(wtxt  (substr (rtos (cadr P11) 2 0) 1 4) (list (- (+ (car P11) WithLine) (* 2 rau) ) (+ (cadr p11) (/ rau 10))) tHeight 0 "L")
(wtxt  (substr (rtos (cadr P11) 2 0) 5) (list  (- (car P11) (/ rau 10))  (- (cadr P11) (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TR")
; Dong Nam
(wtxt  (substr (rtos (cadr P22) 2 0) 1 4) (list (car P22) (+ (cadr p22) (/ rau 10))) tHeight 0 "L")
(wtxt  (substr (rtos (cadr P22) 2 0) 5) (list (- (+ (car P22) (* 2 rau)) WithLine) (- (cadr P22) (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TR")
;Dong Bac
(wtxt  (substr (rtos (cadr P4) 2 0) 1 4) (list (car P4) (+ (cadr P4) (/ rau 10))) tHeight 0 "L")
(wtxt  (substr (rtos (cadr P4) 2 0) 5) (list (- (+ (car P4) (* 2 rau)) WithLine) (- (cadr P4) (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TR")
;Tay Bac
(wtxt  (substr (rtos (cadr P3) 2 0) 1 4) (list (- (+ (car P3) WithLine) (* 2 rau)) (+ (cadr P3) (/ rau 10))) tHeight 0 "L")
(wtxt  (substr (rtos (cadr P3) 2 0) 5) (list (- (car P3) (/ rau 10)) (- (cadr P3) (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TR")
;;;;;;;;GHI TOA DOA X 503456.789
    ;Tay Nam
(wtxt  (substr (rtos (car P11) 2 0) 1 3) (list (-  (car P11)  (/ rau 10)) (+  (- (cadr P11) rau ) (/ rau 10))) tHeight 0 "TR")
(wtxt  (substr (rtos (car P11) 2 0) 4) (list (+ (car P11) (/ rau 10)) (+  (- (cadr P11)rau) (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TL")
;;;      ; Dong Nam
(wtxt  (substr (rtos (car P22) 2 0) 1 3) (list (- (car P22) (/ rau 10)) (+  (- (cadr P22) rau) (/ rau 10))) tHeight 0 "TR")
(wtxt  (substr (rtos (car P22) 2 0) 4) (list (+ (car P22) (/ rau 10))  (+  (- (cadr P22) rau ) (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TL")
;;;    ;Dong Bac
(wtxt  (substr (rtos (car P4) 2 0) 1 3) (list (- (car P4) (/ rau 10)) (+  (+ (cadr P4) rau) (* 2 (/ rau 10)))) tHeight 0 "TR")
(wtxt  (substr (rtos (car P4) 2 0) 4) (list (+ (car P4) (/ rau 10)) (+  (+ (cadr P4) rau) (* 2 (/ rau 10))))  (/ (* 3 tHeight) 2) 0 "TL")
;;;    ;Tay Bac
(wtxt  (substr (rtos (car P3) 2 0) 1 3) (list (- (car P3) (/ rau 10)) (+  (+ (cadr P3) rau) (* 2 (/ rau 10)))) tHeight 0 "TR")
(wtxt  (substr (rtos (car P3) 2 0) 4) (list (+ (car P3) (/ rau 10)) (+  (+ (cadr P3) rau) (* 2 (/ rau 10))))  (/ (* 3 tHeight) 2) 0 "TL")
(setvar "CECOLOR" "40")
(command "rectangle" "w" WithLine (list (- (car P11) (* 2 rau)) (- (cadr P11) (* 2 rau))) (list (+ (car P4) (* 2 rau)) (+ (cadr P4) (* 2 rau))))
(setvar "CECOLOR" "256")
    ;;DoY
(while (< x1_tmp x2)
    (setq objLine (ST:Entmake-Line (list x1_tmp y1)(list x1_tmp y2)))
    (setq x1_tmp (+ x1_tmp dis)
        lstInter (ST:Ent-IntersObj (entlast) e)
        lstInter (vl-sort lstInter '(lambda (x y) (< (cadr x)(cadr y))))
        1st (car lstInter) 2nd (cadr lstInter)
        )
    ;Duoi
    (ST:Entmake-Line 1st (mapcar '- 1st (list 0 (* 2 rau) 0)))
    (wtxt  (substr (rtos (car 1st) 2 0) 1 3) (list (- (car 1st) (/ rau 10)) (+  (- (cadr 1st) rau) (/ rau 10))) tHeight 0 "TR")
    (wtxt  (substr (rtos (car 1st) 2 0) 4) (list (+ (car 1st) (/ rau 10)) (+  (- (cadr 1st) rau) (/ rau 10)))  (/ (* 3 tHeight) 2) 0 "TL")
 
    ;Tren
    (ST:Entmake-Line 2nd (mapcar '+ 2nd (list 0 (* 2 rau) 0 )))
    (wtxt  (substr (rtos (car 2nd) 2 0) 1 3) (list (- (car 2nd) (/ rau 10)) (+  (+ (cadr 2nd) rau) (* 2 (/ rau 10)))) tHeight 0 "TR")
    (wtxt  (substr (rtos (car 2nd) 2 0) 4) (list (+ (car 2nd) (/ rau 10)) (+  (+ (cadr 2nd) rau) (* 2 (/ rau 10))))  (/ (* 3 tHeight) 2) 0 "TL")
 
    (entdel objLine)
;;Do sth else        
)
(setvar "OSMODE" olmode)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dinhhcn (P Cdai CCao / ) ;Dinh hinh chu nhat
(setq P2 (Polar P 0 Cdai))
(setq P4 (Polar P (/ pi 2) CCao))
(setq P3 (Polar P4 0 Cdai))
(setq DHV (list P P2 P3 P4 P))
DHV
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun RTD(x) (/ (* x 180) pi) )
(defun round+ (num prec)
    (if (< 0 prec)
        (* prec
             (if (minusp (setq num (/ num prec)))
                 (fix num)
                 (if (= num (fix num))
                     num
                     (fix (1+ num))
                 )
             )
        )
    num
    )
)
(defun ST:Entmake-Point (pt Len / lstEn)
    (append (list (ST:Entmake-Line (mapcar '- pt (list (/ len 2) 0 0))(mapcar '+ pt (list (/ len 2) 0 0))))
    (list (ST:Entmake-Line (mapcar '- pt (list 0 (/ len 2)  0))(mapcar '+ pt  (list 0 (/ len 2)  0)))))
)
(defun ST:Entmake-Line (p1 p2)(entmakex (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2))))
(defun ST:Ent-IntersObj (e1 e2  / ob1 ob2 g L i kq)
(setq
    ob1 (vlax-ename->vla-object e1)
    ob2 (vlax-ename->vla-object e2)
)    
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
(setq i 0)
(repeat (/ (length L) 3)
    (setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))
    (setq i (+ i 3))
)
kq
)
(defun ST:GGBP (p1 p2 dis len_perLine / x1) ;trai -> phai
        (setq x1 (round+ (car p1) dis))
        (while (< x1 (car p2))
            (ST:Entmake-Point  (list  x1 (cadr p1))    len_perLine)
            (setq x1 (+ x1 dis)))
)

(defun wtxt (string Point Height Ang justify / Lst)
 (setq Lst (list '(0 . "TEXT")
   (cons 8 (if Layer Layer (getvar "Clayer")))
   (cons 62 (if Color Color 256))
   (cons 10 point)
   (cons 40 Height)
   (cons 1 string)
   (if Ang (cons 50 Ang))
   (cons 7 (if Style Style (getvar "Textstyle"))))
  justify (strcase justify))
 (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
               ((= justify "L") (setq Lst (append Lst (list (cons 72 0)(cons 73 0) (cons 10 point)))))
            ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
            ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
            ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
            ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
            ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))   
            ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
            ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
            ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
            ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
            ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
            ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
 (entmake Lst)
)

 


<<

Filename: 431020_vk.lsp
Tác giả: hochoaivandot
Bài viết gốc: 272833
Tên lệnh: ket ptb dvh
viết Lisp dời text về vị trí điểm point gần nhất

 

Thể theo y/c của bác PhamThanhBinh và bạn Hochoaihetdot cùng chủ topic, tôi viết lại Lisp này để sử dụng thuận tiện...

>>

 

Thể theo y/c của bác PhamThanhBinh và bạn Hochoaihetdot cùng chủ topic, tôi viết lại Lisp này để sử dụng thuận tiện hơn.

Tốc độ tương đương Lisp bác Bình nhưng sẽ không để "lọt lưới".

Đã test trên bản vẽ (đính kèm) gồm 5000 Texts và 5000 Points thì Lisp của tôi và của bác Bình đều mất tầm 15".

Có thể phân mảnh nhỏ dần để tăng tốc độ, nhưng khá rắc rối nên làm biếng lắm.

Các bạn test cho vui nhé!

File Cad::

http://www.cadviet.com/upfiles/3/67029_tim_diem_gan_text.dwg

File Lisp (gồm 3 LisP của KET, PTB, DVH):

 

;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/90291-yeu-cau-viet-lisp-doi-text-ve-vi-tri-diem-point-gan-nhat/
;by Ketxu, khoang 4'15" cho 5000 Texts + 5000 Points.
(defun C:KET(/ lst lstData lstT lstP p)
 (and
  (setq ss (ssget (list (cons 0 "TEXT,POINT"))))
  (setq time (getvar "millisecs"))
  (not (command "undo" "be"))
  (setq lstData (mapcar 'entget (acet-ss-to-list ss)))
  (foreach e lstData
   (if (= (cdadr e) "TEXT")
    (setq lstT (cons e lstT)) (setq lstP (cons e lstP)))))
 (foreach oT lstT
  (setq p (acet-dxf 11 oT))
  (setq lstP (vl-sort lstP '(lambda(x y)(< (distance (acet-dxf 10 x) p)(distance (acet-dxf 10 y) p)))))
  (entmod (append oT (list (cons 11 (acet-dxf 10 (car lstP))))))
  (setq lstP (cdr lstP)))
 (command "undo" "e")
 (setq phut (/ (- (getvar "millisecs") time) 60000.0))
 (princ (strcat "\nThoi gian chay chuong trinh: " (itoa (fix phut)) "'" (itoa (fix (* 60 (- phut (fix phut))))) "\"."))
 (princ))
;by PhamThanhBinh, khoang 15" cho 5000 Texts + 5000 Points.
(defun C:PTB (/ oldos sslst box polst p)
 (setq sslst (mapcar 'entget (acet-ss-to-list (ssget (list (cons 0 "text"))))))
 (setq time (getvar "millisecs"))
 (command "undo" "be")
 (foreach e sslst
  (setq box (acet-ent-geomextents (cdr (assoc -1 e)))
        polst (mapcar 'entget (acet-ss-to-list (ssget "c" (car box) (cadr box) (list (cons 0 "point")))))
        p (cdr (assoc 11 e)))
  (if polst
   (progn
    (setq polst (vl-sort polst '(lambda (x y) (< (distance (cdr (assoc 10 x)) p) (distance (cdr (assoc 10 y)) p)))))
    (entmod (subst (cons 11 (cdr (assoc 10 (car polst)))) (assoc 11 e) e)))))
 (command "undo" "e")
 (setq phut (/ (- (getvar "millisecs") time) 60000.0))
 (princ (strcat "\nThoi gian chay chuong trinh: " (itoa (fix phut)) "'" (itoa (fix (* 60 (- phut (fix phut))))) "\"."))
 (princ))
;by DoanVanHa, khoang 15" cho 5000 Texts + 5000 Points.
(defun C:DVH(/ ss time lst1 lst2 p1 p2 dis lst3 phut)
 (and
  (setq ss (ssget (list (cons 0 "TEXT,POINT"))))
  (setq time (getvar "millisecs"))
  (not (command "undo" "be"))
  (foreach e (mapcar 'entget (acet-ss-to-list ss))
   (if (= (cdadr e) "TEXT")
    (setq lst1 (cons (list (cdr (assoc -1 e)) (cdr (assoc 11 e))) lst1)) (setq lst2 (cons (cdr (assoc 10 e)) lst2))))
  (= (length lst1) (length lst2))
  (foreach n lst1
   (setq ent1 (car n)
         p1 (cadr n)
p2 (car lst2)
lst3 (list ent1 p1 p2 (distance p1 p2)))
   (foreach p2 lst2
    (if (< (setq dis (distance p1 p2)) (cadddr lst3))
     (setq lst3 (list ent1 p1 p2 dis))))
   (entmod (subst (cons 11 (setq p2 (caddr lst3))) (cons 11 (cadr lst3)) (entget (car lst3))))
   (setq lst2 (vl-remove p2 lst2)))
   (not (command "undo" "e")))
 (setq phut (/ (- (getvar "millisecs") time) 60000.0))
 (princ (strcat "\nThoi gian chay chuong trinh: " (itoa (fix phut)) "'" (itoa (fix (* 60 (- phut (fix phut))))) "\"."))
 (princ))
 

 

Mình đã đọc code của DoanVanHa.

Về cơ bản, lisp DVH gần như giống lisp ketxu. Nhưng có 1 cải thiện rất hay là (setq lst2 (vl-remove p2 lst2)).

Tức là sau mỗi vòng lặp, đã tìm được điểm point nào gần nhất rồi thì loại ra khỏi list để vòng lặp sau giảm bớt 1 vòng lặp.

Cảm ơn bác Hạ!


<<

Filename: 272833_ket_ptb_dvh.lsp
Tác giả: quochuyksxd
Bài viết gốc: 186101
Tên lệnh: mtxtc
Lisp đếm đối tượng Mtext lập thành bảng

<p></p>

<p>hề hề hề,</p>

<p>Bạn dùng thử cái này coi sao nhé.</p>

<p>

>>

<p></p>

<p>hề hề hề,</p>

<p>Bạn dùng thử cái này coi sao nhé.</p>

<p>

</p>
<p> </p>
<div>(defun c:mtxtc ()</div>
<div>(command "undo" "be" )</div>
<div>(setq oldos (getvar "osmode" ) )</div>
<div>(setvar "osmode" 0 )</div>
<div>(alert "\n Chon cac vung khung ten tung ban ve" )</div>
<div>(setq ssmt (ssget (list (cons 0 "*text") (cons 8 "TEN BAN VE,STT BAN VE" )))</div>
<div>          n (sslength ssmt) i 0 lst1 (list) lst2 (list) )</div>
<div>(while (< i n)</div>
<div>    (setq e (ssname ssmt i))</div>
<div>    (if (= (cdr (assoc 8 (entget e))) "TEN BAN VE")</div>
<div>        (setq lst1 (append lst1 (list (cdr (assoc 1 (entget e))))))</div>
<div>        (setq lst2 (append lst2 (list (cdr (assoc 1 (entget e))))))</div>
<div>    )</div>
<div>    (setq i (1+ i))</div>
<div>)</div>
<div>(styleset)</div>
<div>(setq h (getreal "\n Nhap chieu cao text trong bang: ")</div>
<div>          p (getpoint "\n Chon diem dat bang " )  )</div>
<div>(command "line" p (setq p1 (polar p 0 (* 40 h))) (setq p2 (polar p1 (* 1.5 pi) (* (1+ (/ n 2)) 3 h))) (setq p3 (polar p2 pi (* 40 h))) "c" )</div>
<div>(command "line" (setq p5 (Polar p 0 (* 5 h))) (polar p5 (* 1.5 pi) (* (1+ (/ n 2)) 3 h)) "" )</div>
<div>(command "line" (setq p6 (Polar p 0 (* 33 h))) (polar p6 (* 1.5 pi) (* (1+ (/ n 2)) 3 h)) "" )</div>
<div>(command "text" "j" "mc" (list (+ (car p) (* 2.5 h)) (- (cadr p) (* 1.5 h))) h 0 "STT" )</div>
<div>(command "text" "j" "mc" (list (+ (car p) (* 19 h)) (- (cadr p) (* 1.5 h))) h 0  "TÊN B\\U+1EA2N V\\U+1EBC" )</div>
<div>(command "text" "j" "mc" (list (+ (car p) (* 36.5 h)) (- (cadr p) (* 1.5 h))) h 0 "KÍ HI\\U+1EC6U")</div>
<div>(setq  j 1)</div>
<div>(repeat (/ n 2)</div>
<div>      (command "line" (setq p0 (polar p (* 1.5  pi) (* j 3 h))) (polar p0 0 (* 40 h)) "" ) </div>
<div>      (command "text" "j" "mc" (list (+ (car p0) (* 2.5 h)) (- (cadr p0) (* 1.5 h))) h 0 (rtos j 2 0))</div>
<div>      (command "text" "j" "mc" (list (+ (car p0) (* 19 h)) (- (cadr p0) (* 1.5 h))) h 0  (nth (1- j) lst1))</div>
<div>      (command "text" "j" "mc" (list (+ (car p0) (* 36.5 h)) (- (cadr p0) (* 1.5 h))) h 0 (nth (1- j) lst2))</div>
<div>      (setq j (1+ j))</div>
<div>)</div>
<div>(setvar "osmode" oldos)</div>
<div>(command "undo" "e" )</div>
<div>(princ)</div>
<div>)        </div>
<div> </div>
<div>(defun styleset ()</div>
<div>(setq stl (getvar "textstyle")</div>
<div>     	h (getvar "textsize"))</div>
<div>(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))</div>
<div>) </div>
<div>

</div>

Đã load về và không sử dụng được bạn ah


<<

Filename: 186101_mtxtc.lsp
Tác giả: newness
Bài viết gốc: 55108
Tên lệnh: c1 c2 c4
Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)

Nhanh quá! Cái lisp NN kia giúp tôi đỡ được bao nhiêu công khi phải BO line thanh PLINE.

 

Giờ đến vễ cửa, cửa đi, cửa sổ... nhiều quá. Copy từ thư viện ra thì lại...

>>
Nhanh quá! Cái lisp NN kia giúp tôi đỡ được bao nhiêu công khi phải BO line thanh PLINE.

 

Giờ đến vễ cửa, cửa đi, cửa sổ... nhiều quá. Copy từ thư viện ra thì lại phải SCALE rồi làng nhằng LAYER không đúng với bản vẽ của mình ! Vậy thì co cách nào không nhỉ?

 

Bài 5: Vẽ cửa đi

 

;-------------------------------------------------------------------------------------
;ve cua di 1 canh
;-------------------------------------------------------------------------------------
(defun c:c1 (/ p1 p2 p3 p4 p5 daicua x y)
(setq osm (getvar "osmode"))  
(setq	p1     (getpoint "\nHay vao diem goc cua: ")

p2     (getpoint p1 "\nHay vao diem mut cua: ")
p3     (getpoint p1 "\nHay vao huong cua: ")
daicua (distance p1 p2)
x      (car p1)
y      (car (cdr p1))
x      25
y      daicua
p4     (list x y)
p5     (list daicua 0)
 )
 (setvar "OSMODE" 0)
 (if (l3d_khongthanghang p1 p2 p3)
   (progn
     (command ".UCS" "3" p1 p2 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")
   )
   (princ "\n3 diem nhap vao khong duoc thang hang")
 )
(setvar "osmode" osm)       
)
;-------------------------------------------------------------------------------------
;ve cua di 2 canh
;-------------------------------------------------------------------------------------
(defun c:c2 (/ p1 p2 p3 p4 p5 daicua x y)
 (setq osm (getvar "osmode"))  
 (setq	p1     (getpoint "\nHay vao diem goc cua: ")
p2     (getpoint p1 "\nHay vao diem mut cua: ")
p3     (getpoint p1 "\nHay vao huong cua: ")
daicua (/ (distance p1 p2) 2.0)
x      (car p1)
y      (car (cdr p1))
x      25
y      daicua 
p4     (list x y)
p5     (list daicua 0)
 )
 (setvar "OSMODE" 0)
 (if (l3d_khongthanghang p1 p2 p3)
   (progn
     (command ".UCS" "3" p1 p2 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

     (command ".UCS" "3" p2 p1 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

   )

   (princ "\n3 diem nhap vao khong duoc thang hang")
 )
 (setvar "osmode" osm)       
)
;-------------------------------------------------------------------------------------
;ve cua di 4 canh
;-------------------------------------------------------------------------------------
(defun c:c4 (/ p1 p2 p3 p4 p5 daicua x y)
 (setq osm (getvar "osmode"))    
 (setq	p1     (getpoint "\nHay vao diem goc cua: ")
p2     (getpoint p1 "\nHay vao diem mut cua: ")
p3     (getpoint p1 "\nHay vao huong cua: ")
daicua (/ (distance p1 p2) 4.0)
x      (car p1)
y      (car (cdr p1))
x      25
y      daicua 
p4     (list x y)
p5     (list daicua 0)
 )
 (setvar "OSMODE" 0)
 (if (l3d_khongthanghang p1 p2 p3)
   (progn

     (setq diem1 (diemgiua p1 (diemgiua p1 p2)))
     (setq diem2 (diemgiua p1 p2))
     (setq diem3 (diemgiua p2 (diemgiua p1 p2)))      

     (command ".UCS" "3" p1 p2 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

     (command ".UCS" "3" diem1 p2 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)     
     (command ".UCS" "P")      

     (command ".UCS" "3" p2 p1 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

     (command ".UCS" "3" diem3 p1 p3)
     (command ".rectangle" "0,0" p4)
     (command ".Arc" p5 "C" "0,0" p4)
     (command ".UCS" "P")

   )

   (princ "\n3 diem nhap vao khong duoc thang hang")
 )
(setvar "osmode" osm)         
)
;-----------------------------------------------------------------------------

 

Có 3 lệnh trong lisp này.

c1: vẽ cửa đi 1 cánh

c2: vẽ cửa đi 2 cánh

c4: vẽ cửa đi 4 cánh

 

Thế còn cửa sổ thì sao nhỉ ?

 

Bài 6: Vẽ cửa sổ

 

(defun c:w1(/ data_m l1 l2 p1 p2 check)

(defun wd_import(/ p3 p4 p5 p6)
   (setq data_m (ssget))
   (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
   (setq l1 nil l2 nil check 1)
   (if (not (= nil data_m)) (progn
       (setq l1 (entget (ssname data_m 0)))
       (setq l2 (entget (ssname data_m 1)))
       (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
       (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
       (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
       (if (= 1 check) (progn
           (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
           (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
           (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
           (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
           (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
       ))
   ) (setq check 0))
   (princ)
)

(defun wd_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 
   (if (> (abs (- (nth 1 p1) (nth 1 p3)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p1) (nth 1 p4)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p5)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p6)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (= 0 check) (princ "\ninvalid data") (progn
       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
       (mkline p7 p8 l1)

       (setq getom (getvar "osmode"))
       (setvar "osmode" 0)

       (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))
       (setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
       (setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

       (drawrt2 p7 p8 ll1)

       (setvar "osmode" getom)
       (command "erase" data_m "")

   ))
   (princ)
)

(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 

   (if (> (abs (- (nth 0 p1) (nth 0 p3)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p1) (nth 0 p4)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p5)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p6)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

   (if (= 0 check) (princ "\ninvalid data") (progn

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq getom (getvar "osmode"))
       (setvar "osmode" 0)

       (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))
       (setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

       (drawrt3 p7 p8 ll1)

       (setvar "osmode" getom)
       (command "erase" data_m "")
   ))
   (princ)
)

   (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
   (if (= 0 check) (princ "\ninvalid data") (progn
       (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
                      (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
       (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
                      (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


   ))

   (princ)

)
   (wd_import)
 	(ai_undo_push)
   (wd_procced)
 	(ai_undo_pop)	
)
(defun c:w2(/ data_m l1 l2 p1 p2 check)

(defun wd_import(/ p3 p4 p5 p6)
   (setq data_m (ssget))
   (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))
   (setq l1 nil l2 nil check 1)
   (if (not (= nil data_m)) (progn
       (setq l1 (entget (ssname data_m 0)))
       (setq l2 (entget (ssname data_m 1)))
       (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))
       (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))
       (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))
       (if (= 1 check) (progn
           (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))
           (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))
           (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))
           (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))
           (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))
       ))
   ) (setq check 0))
   (princ)
)

(defun wd_procced()

(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 
   (if (> (abs (- (nth 1 p1) (nth 1 p3)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p1) (nth 1 p4)))
          (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p5)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (> (abs (- (nth 1 p2) (nth 1 p6)))
          (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))
   (if (= 0 check) (princ "\ninvalid data") (progn
       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))
       (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))
       (mkline p7 p8 l1)

       (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))

       (setq ll1 (list
           (cons 0 "line")
           (cons 8 (getvar "clayer"))
       ))

	(if (< (nth 0 p1) (nth 0 ls2)) (progn
       	(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
		(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))
		(setq p7 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p7) 0))
       	(drawrt2 p7 p8 ll1)

		(setq p7 (list (- (nth 0 ls2) 70) (- (nth 1 ls1) 100) 0))
		(setq p8 (list (- (nth 0 ls2) 70) (+ (nth 2 ls1) 100) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (+ (nth 0 p7) 70) (nth 1 p7) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (+ (nth 0 p8) 70) (nth 1 p8) 0))
		(mkline p8 p9 ll1)
    )(progn
	   	(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))
		(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))
		(setq p8 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p8) 0))
       	(drawrt2 p7 p8 ll1)

		(setq p7 (list (+ (nth 1 ls2) 70) (- (nth 1 ls1) 100) 0))
		(setq p8 (list (+ (nth 1 ls2) 70) (+ (nth 2 ls1) 100) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (- (nth 0 p7) 70) (nth 1 p7) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (- (nth 0 p8) 70) (nth 1 p8) 0))
		(mkline p8 p9 ll1)
	))


       (command "erase" data_m "")

   ))
   (princ)
)

(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)

   (setq p3 (cdr (assoc 10 l1))) 
   (setq p4 (cdr (assoc 11 l1))) 
   (setq p5 (cdr (assoc 10 l2))) 
   (setq p6 (cdr (assoc 11 l2))) 

   (if (> (abs (- (nth 0 p1) (nth 0 p3)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p1) (nth 0 p4)))
          (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p5)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))
   (if (> (abs (- (nth 0 p2) (nth 0 p6)))
          (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))

   (if (= 0 check) (princ "\ninvalid data") (progn

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))
       (mkline p7 p8 l1)

       (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )))
;        (princ ls1)
       (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))
       (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

       (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)
       (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))
       (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))
       (mkline p7 p8 l1)

	(setq getom (getvar "osmode"))
       (setvar "osmode" 0)

	(setq ll1 (list
            (cons 0 "line")
            (cons 8 (getvar "clayer"))
        ))
	(setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))
	;(princ ls2)

	(if (> (nth 1 p1) (nth 1 ls2)) (progn

       	(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       	(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))
		(setq p8 (list (nth 2 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))

       	(drawrt3 p7 p8 ll1)

		(setq p7 (list (- (nth 1 ls1) 100) (+ (nth 1 ls2) 70) 0))
		(setq p8 (list (+ (nth 2 ls1) 100) (+ (nth 1 ls2) 70) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (nth 0 p7) (- (nth 1 p7) 70) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (nth 0 p8) (- (nth 1 p8) 70) 0))
		(mkline p8 p9 ll1)
	)(progn
	  	(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))
       	(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))
		(setq p7 (list (nth 1 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))

		(drawrt3 p7 p8 ll1)


		(setq p7 (list (- (nth 1 ls1) 100) (- (nth 0 ls2) 70) 0))
		(setq p8 (list (+ (nth 2 ls1) 100) (- (nth 0 ls2) 70) 0))
		(mkline p7 p8 ll1)

		(setq p9 (list (nth 0 p7) (+ (nth 1 p7) 70) 0))
		(mkline p7 p9 ll1)

		(setq p9 (list (nth 0 p8) (+ (nth 1 p8) 70) 0))
		(mkline p8 p9 ll1)


	))

	(setvar "osmode" getom)

       (command "erase" data_m "")
   ))
   (princ)
)

   (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)
   (if (= 0 check) (princ "\ninvalid data") (progn
       (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))
                      (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))
       (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))
                      (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))


   ))

   (princ)

)
   (wd_import)
   (wd_procced)
)

 

Có 2 lệnh trong lisp này.

w1: vẽ cửa sổ kiểu 1

w2: vẽ cửa sổ kiểu 2

 

mình không thể sài nổi cái này


<<

Filename: 55108_c1_c2_c4.lsp
Tác giả: lamcoi16
Bài viết gốc: 92207
Tên lệnh: 2csv
nhờ giúp list tính diện tích trong cad và tự động nhập trong excel
Bạn chạy thử Lisp xuất ra file CSV

sau đó dùng Excel mở file này, save as qua file *.xls

 

Cách sử dụng : tên lệnh 2CSV

lần luơt chọn :...

>>
Bạn chạy thử Lisp xuất ra file CSV

sau đó dùng Excel mở file này, save as qua file *.xls

 

Cách sử dụng : tên lệnh 2CSV

lần luơt chọn :

- Text để lấy số lô

- đối tuơng để lấy Diện tích

- đối tuơng để lấy Khoảng lùi

 

lặp lại các buớc trên, nhấn Enter để kết thúc quá trình chọn.

- Chỉ ra ten file -> kết thúc.

 

(defun c:2Csv (/ chdai dtich ent1 ent2 ent3 lst solo tmp)
 (vl-load-com)  
 (while (and
   (setq ent1 (car (entsel "\nchon Text de lay So lo :")))
   (= (cdr (assoc 0 (entget ent1))) "TEXT")
   (setq solo (vlax-get(vlax-Ename->Vla-Object ent1)'TextString))	   
   (setq ent2 (car (entsel "\nchon doi tuong de lay Dien tich :"))
	 ent2 (vlax-Ename->Vla-Object ent2))
   (and (vlax-property-available-p ent2 'area)
     (setq dtich (vlax-get ent2 'Area) )  )	   
   (setq ent3 (car (entsel "\nchon doi tuong de lay Khoang lui :"))
	 ent3 (vlax-Ename->Vla-Object ent3))
   (and (vlax-property-available-p ent3 'Length)
     (setq chdai (vlax-get ent3 'Length) )  )  )
   (princ "\n")   
   (princ (setq tmp (strcat solo "," (rtos dtich) "," (rtos chdai))))
   (setq lst (append lst (list tmp)))  )  
 (if (setq tmp (getfiled "Ten file " (getvar "dwgprefix") "csv" 1))
   (progn
     (setq tmp (open tmp "a"))
     (write-line "So lo,Dien tich,Khoang lui" tmp)      
     (foreach txt lst
(write-line txt tmp)   )
     (close tmp)))
 (princ))

anh ƠI ANH GIÚP EM CÁI NÀY ĐƯỢC KHÔNG.EM CÂN TINH DIỆN TÍCH NHƯ TRONG BẢN VẼ http://www.cadviet.com/upfiles/2/nv_kenh_my_3.dwg EM ĐÃ ĐỌC MỘT SỐ BÀI VIẾT RỒI MÀ KHÓ HIỂU QUÁ .


<<

Filename: 92207_2csv.lsp
Tác giả: leejang
Bài viết gốc: 158536
Tên lệnh: cs
Lisp cộng - trừ - nhân - chia 2 hàng số cho ra hàng thứ 3

Chú ý, chú ý : Lisp chạy được khi cài phụ trợ Express.

Bạn tski259 chưa cài Express nên...

>>

Chú ý, chú ý : Lisp chạy được khi cài phụ trợ Express.

Bạn tski259 chưa cài Express nên chưa sử dụng được Lisp :rolleyes:

Do vậy, Tue_NV viết lại, không sử dụng hàm ACET-GEOM-SS-EXTENTS-FAST. Các bạn chạy thử xem.

Với phép * /, xuất text sẽ viết sau nhé

(defun c:cs(/ ss lis stp oldlu ctnc ctnch shang ResC ResR matran i j k ptui dem)
;Copy right by Tue_NV
(defun dd(e1 e2 / tb1 tb2)
   (setq tb1 (textbox e1) tb2 (textbox e2))
   (max (abs (- (caadr tb1) (caar tb1))) 
 (abs (- (caadr tb2) (caar tb2))) 
   )
)
(defun layminmax( / minpp maxpp LX LY)
  (vlax-for x (vla-get-activeselectionset (vla-get-activedocument(vlax-get-acad-object)))
(vla-getboundingbox x 'minpp 'maxpp)
(setq LX (append LX (list (car(safearray-value minpp)))
		    (list (car(safearray-value maxpp)))))
(setq LY (append LY (list (cadr(safearray-value minpp)))
		    (list (cadr(safearray-value maxpp)))))
  )
  (setq minp (list (apply 'min LX) (apply 'min LY) 0.0))
  (setq maxp (list (apply 'max LX) (apply 'max LY) 0.0))	
)
(defun arrangess(ss / lst)
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lst (vl-sort lst '(lambda (x y) 
     (if (equal (cadr (assoc 10 (entget x)))
                (cadr (assoc 10 (entget y)))
                (dd (entget x) (entget y))   )
           (> (caddr (assoc 10 (entget x)))
              (caddr (assoc 10 (entget y)))
           )
       (< (cadr (assoc 10 (entget x)))
              (cadr (assoc 10 (entget y)))
           )        
            )
       ))
)
 lst) 
(defun ktrass(ss / i ent ret)
(setq i 0 L (sslength ss))
(while (< i L)
    (if (distof (cdr(assoc 1 (entget (ssname ss i)))))
 (setq i (1+ i) ret t)
 (progn (setq i L ret nil) (alert "Tap ss co chua chu - Khong thuc hien duoc phep tinh"))
    )
 )
ret
)
(vl-load-com)
(setvar "DIMZIN" 0)
(prompt"\nChon ma tran")  
(if (ktrass (setq ss (ssget '((0 . "TEXT")))))
(progn
(layminmax)

(or *stp* (setq *stp* 2))
(setq stp (getint (strcat "\n So chu so thap phan <" (itoa *stp*) "> :")))
(if stp (setq *stp* stp) (setq stp *stp*))
(setq oldlu (getvar "luprec"))
(setvar "luprec" stp)
(setq lis (arrangess ss))

(setq ctnc (cond (ctnc) ("+")))  
(initget "+ -")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh:  <" ctnc ">"))) (ctnc)))
(cond ((= ctnc "+") (setq ctnch + shang 0.0))
     ((= ctnc "-") (setq ctnch - shang 0.0))
)

;(setq lis (reverse lis) )  
(setq ResR '() ResC '() ptui 0.0 i 1 j 0 k 0 Matran '() )
(while (< j (length lis))
  (if (not (equal (cdr(assoc 10 (entget (nth j lis)))) minp  (cdr(assoc 40 (entget (nth j lis))))  ))
(setq i (1+ i) j (1+ j))
(setq j (length lis))
  )
)
(setq j (/ j i))

(Repeat j
   (Repeat i
(setq ptui (ctnch ptui shang (atof (cdr (assoc 1 (entget (nth k lis)))))) 
	matran (append matran (list (atof (cdr (assoc 1 (entget (nth k lis)))))))
	k (1+ k))
  )
  (setq ResC (append ResC (list ptui)) ptui 0.0)
)
(setq k 0 dem 0)
(Repeat i
  (Repeat j
(setq ptui (ctnch ptui shang (nth k matran)))
(setq k (+ k i))
  )
(setq ResR (append ResR (list ptui)) ptui 0.0)
(setq dem (1+ dem))
(setq k dem)
)
))
(Alert (strcat "\nKet qua hang : " (vl-princ-to-string ResR)
        "\n\nKet qua Cot  : " (vl-princ-to-string ResC)
)
)
(princ (strcat "\nKet qua hang : " (vl-princ-to-string ResR)
        "\n\nKet qua Cot  : " (vl-princ-to-string ResC)
)
)
) 

 

Em chạy thử trên CAD 2012 thì chạy ok. Nhưng đúng là nó chưa ghi kết quả được. Chủ để này hay, khi nào có time bác TUỆ hoàn thiện nốt cho anh em thì tốt quá !


<<

Filename: 158536_cs.lsp
Tác giả: vbao
Bài viết gốc: 42434
Tên lệnh: ins point
Chèn points vào vị trí text
Bạn dùng thử LISP sau :
(defun c:ins_point (/ ss i ent point curLayer)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if...
>>
Bạn dùng thử LISP sau :
(defun c:ins_point (/ ss i ent point curLayer)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if (not (tblsearch "layer" "points"))
(command "-layer" "n" "points"  "c" "1" "points" "") ) ; tao layer Point
     (setvar "clayer" "points")	    		     ; Set layer Current
     (repeat (sslength ss)
(setq ent (ssname ss i)
      point (cdr (assoc 10 (entget ent)))
      i	 (1+ i)
)
(entmake (list (cons 0 "POINT") (cons 10 point)))
     )
     (setvar "clayer" curLayer)
   )
 )
 (princ)
)

 

gia_bach có thể viết thêm đối tượng POINT vừa tạo, nếu cần theo yêu cầu của người sử dụng thì ghi thêm vào POINT có tọa độ z=giá trị của text trong tiện ích trên được không? Thanks


<<

Filename: 42434_ins_point.lsp
Tác giả: phongtran86
Bài viết gốc: 400228
Tên lệnh: tt%C2%A0
Nhờ Chỉnh Lisp Cắt Thép Dầm Momen

 

Theo "Nghị Quyết" của Topic, Lisp 2 ra đời: :D

>>

 

Theo "Nghị Quyết" của Topic, Lisp 2 ra đời: :D

(defun c:tt  (/ thuc_hien dkd kcd kwo ss)
 (defun thuc_hien  (/ ent i len sld str)
  (or dkd (setq dkd (getvar 'USERI5)))
  (or kcd (setq kcd (getvar 'USERR2)))
  (repeat (setq i (sslength ss))
   (setq ent (ssname ss (setq i (1- i)))
         len (cdr (assoc 42 (entget ent)))
         sld (1+ (fix (/ len kcd)))
         str (strcat "<>\\X" (itoa sld) "~" (itoa dkd) "a" (rtos kcd 2 0)))
   (vla-put-TextOverride (vlax-ename->vla-object ent) str)))
 (or (> (getvar 'USERI5) 0) (setvar 'USERI5 6))
 (or (> (getvar 'USERR2) 0) (setvar 'USERR2 150))
 (vl-load-com)
 (if (setq ss (ssget '((0 . "DIMENSION"))))
  (progn (setq kwo t)
         (while kwo
          (initget "T K")
          (setq kwo (getkword
                     (strcat "\nThep dai \U+00D8" (itoa (getvar 'USERI5)) " /Khoang cach a" (rtos (getvar 'USERR2) 2 0) " <T or K or Enter to Override>:")))
          (cond ((eq kwo "T")
                 (initget 6)
                 (setq dkd (cond ((getint (strcat "\nDuong kinh thep dai \U+00D8 <" (itoa (getvar 'USERI5)) ">:")))
                                 ((getvar 'USERI5))))
                 (setvar 'USERI5 dkd))
                ((eq kwo "K")
                 (initget 6)
                 (setq kcd (cond ((getreal (strcat "\nKhoang cach thep dai a <" (rtos (getvar 'USERR2) 2 0) ">:")))
                                 ((getvar 'USERR2))))
                 (setvar 'USERR2 kcd))
                (t (setq kwo nil))))
         (thuc_hien)))
 (princ))

anh chỉnh chút xíu cho em.

1. khi gợi chọn dim ấy thì mình có thể nhấn T để chỉnh đường kính thép đai, K để chỉnh khoảng cách. k ấn j chọn luôn dim thì nó lấy giá trị cũ của T,K chứ k phải chọn dim xong mới hiện gợi ý chỉnh T, K.

2. Mà hình như biến lưu hệ thống K anh để là USERR2 là biến lưu hệ thống lớp btong bảo vệ của lisp vẽ mômen dầm. nên nó bị thay đổi lớp bảo vệ, khi vẽ lệnh kia. anh setq kcd là USERR4 <khoang cách đai nhịp> :D hoặc làm sao 2 cái này k ảnh hưởng đến nhau dc ko. Thế thì tốt


<<

Filename: 400228_tt%C2%A0.lsp
Tác giả: Khonghedongian
Bài viết gốc: 381760
Tên lệnh: gct
Lisp Ghép Text Cần Giúp Đỡ

 

Bạn thử lisp này

(defun c:gct (/ ss1 ss2 _NHT:sssortXY)
  ;;sap xep cac toi tuong theo X hoac Y
;;ss -...
>>

 

Bạn thử lisp này

(defun c:gct (/ ss1 ss2 _NHT:sssortXY)
  ;;sap xep cac toi tuong theo X hoac Y
;;ss - selection by ssget
;;dir: T - sap xep theo X tang dan
;;     nil - sap xep theo Y giam dan
;;vla: T/nil
;;return OBJECT/ENAME

(defun _NHT:sssortXY (ss dir vla / lstent)
  ;(setq ss(ssget))
  (if ss
    (progn
    (setq lstent
	   (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		    (if	dir
		      
		      '(lambda (x y)
			 
			 (< (car (cdr (assoc 10 (entget x))))
			    (car (cdr (assoc 10 (entget y))))
			 )
		       )
		      
		      '(lambda (x y)
			 (> (cadr (cdr (assoc 10 (entget x))))
			    (cadr (cdr (assoc 10 (entget y))))
			 )
		       )
		    )
	   )
    )
    (if vla (setq lstent(mapcar 'vlax-ename->vla-object lstent)) lstent)
    )
    lstent
  )
)
  (command "_.undo" "be")
  (if (and
	(princ "\nChon cac text o cot 1")
	(setq ss1 (ssget '((0 . "text, mtext"))))
	(princ "\nChon cac text o cot 2")
	(setq ss2 (ssget '((0 . "text, mtext"))))
      )
    (mapcar
      '(lambda (x y)
	 (vla-put-textstring
	   x
	   (strcat (vla-get-textstring x) "-" (vla-get-textstring y))
	 )
       )
      (_NHT:sssortXY ss1 nil t)
      (_NHT:sssortXY ss2 nil t)
    )
  )
  (command "_.undo" "e")
  (princ)
  )

Lisp bác viết chạy rất ổn. Em cảm ơn các bác đã nhiệt tình giúp đỡ em ạ 


<<

Filename: 381760_gct.lsp
Tác giả: minhphuong_humg
Bài viết gốc: 193954
Tên lệnh: ha1
Lisp lấy giá trị của dimenson, text và xuất ra file text

@Bác ĐVH : Bác đổi foreach sang repeat và dùng Index làm chi ạ ^^

Ngoài ra, nếu dùng *Text thì bác cũng cần xử lý trường hợp có Rtext...

>>

@Bác ĐVH : Bác đổi foreach sang repeat và dùng Index làm chi ạ ^^

Ngoài ra, nếu dùng *Text thì bác cũng cần xử lý trường hợp có Rtext ạ

Theo e thì viết kiểu như thế này :

(defun C:HA1(/ lst fn fw i j) ;Doan Van Ha Cadviet.com
(princ "\nChon cac Text/Mtext/Dimension can xuat ra file...")
(setq lst (mapcar 'entget (acet-ss-to-list (ssget '((0 . "*TEXT,DIMENSION")))))
   	fn (getfiled "Chon file de save" "" "csv" 1)
   	fw (open fn "w") i 0 j 0)
(foreach n lst
(princ
 (cond
  ((wcmatch (cdadr n) "*TEXT")(strcat (acet-dxf 1 n) ";Text" (itoa (setq i (1+ i))) "\n"))  
  ((= (cdadr n) "DIMENSION")(strcat (if (= (acet-dxf 1 n) "")(rtos (acet-dxf 42 n))(acet-dxf 1 n))  ";Dim" (itoa (setq j (1+ j))) "\n"))
 )
  fw
 )
 )
(close fw))

 

P/s thêm : do bác ĐVH chỉ lấy string dạng thô, nên nếu gặp các MText hoặc DimText có Format thì kết quả xuất ra có thể không được như ý (như trường hợp lỗi đầu tiên kia), chứ không phải là true contents nữa ^^

 

 

@Bác ĐVH : Bác đổi foreach sang repeat và dùng Index làm chi ạ ^^

Ngoài ra, nếu dùng *Text thì bác cũng cần xử lý trường hợp có Rtext ạ

Theo e thì viết kiểu như thế này :

(defun C:HA1(/ lst fn fw i j) ;Doan Van Ha Cadviet.com
(princ "\nChon cac Text/Mtext/Dimension can xuat ra file...")
(setq lst (mapcar 'entget (acet-ss-to-list (ssget '((0 . "*TEXT,DIMENSION")))))
   	fn (getfiled "Chon file de save" "" "csv" 1)
   	fw (open fn "w") i 0 j 0)
(foreach n lst
(princ
 (cond
  ((wcmatch (cdadr n) "*TEXT")(strcat (acet-dxf 1 n) ";Text" (itoa (setq i (1+ i))) "\n"))  
  ((= (cdadr n) "DIMENSION")(strcat (if (= (acet-dxf 1 n) "")(rtos (acet-dxf 42 n))(acet-dxf 1 n))  ";Dim" (itoa (setq j (1+ j))) "\n"))
 )
  fw
 )
 )
(close fw))

 

P/s thêm : do bác ĐVH chỉ lấy string dạng thô, nên nếu gặp các MText hoặc DimText có Format thì kết quả xuất ra có thể không được như ý (như trường hợp lỗi đầu tiên kia), chứ không phải là true contents nữa ^^

Anh ơi, em thấy lisp của anh chạy rất hay. Nhưng em thấy khi kích vào dim thì nó lại cho ra số lẻ anh ạ. Ví dụ: kích thước của em là 38 thì lại cho ra là 376.156. Vậy giờ em chỉ muốn lấy nguyên cái số 38 đó thôi thì phải làm thế nào hả anh? Anh giúp em với ạ! Trân trọng cảm ơn anh rất nhiều.

 

http://www.cadviet.com/upfiles/3/2883_dim.rar


<<

Filename: 193954_ha1.lsp
Tác giả: trieubb
Bài viết gốc: 212661
Tên lệnh: eco
Lisp tính diện tích theo layer

Mình thấy vệc này tạm thời làm thủ công + lisp đơn giản không hề chậm lắm đâu, và mọi người sẽ hiện thực hóa nó.Ta sẽ không dùng...

>>

Mình thấy vệc này tạm thời làm thủ công + lisp đơn giản không hề chậm lắm đâu, và mọi người sẽ hiện thực hóa nó.Ta sẽ không dùng lệnh aa để đo diện tích,vì chưa có đối tượng bao,hoặc phải kích điểm rất lâu,mà dùng mắt thường để tạo ra đường biên đa giác bao ngoài trước.

1.Như bạn nói, đường biên chỉ bao gồm 2 layer, vậy trước tiên bạn layiso 2 layer này trước đã nhé.

2.Sau đó dùng lisp nối các line bao ngoài thành 1 pline kín

3.Lấy diện tích đa giác bao ngoài này bằng các lisp tính diện tích có sẵn trên diễn đàn

Các thao tác để tạo pline bao ngoài có thể gói gọn bằng lisp này, của 1 Pro người nga do 1 pro người Việt (^^) giới thiệu.Lệnh Eco.Sau khi có em bao ngoài rồi thì việc còn lại k có j phứcc tạp cả ^^

 

;;;; External contour of objects(defun C:ECO (/   	*error* blk 	obj 	MinPt   MaxPt   hiden              pt      pl      unnamed_block   isRus   tmp_blk adoc              blks    lays    lay 	oname   sel 	csp 	loc              sc      ec      ret 	DS      osm 	iNSpT         	)  (defun *error* (msg)    (princ msg)    (mapcar '(lambda (x) (vla-put-visible x :vlax-true)) hiden)    (vla-endundomark adoc)    (if (and tmp_blk         	(not (vlax-erased-p tmp_blk))         	(vlax-write-enabled-p tmp_blk)        ) ;_ end of and      (vla-erase tmp_blk)    ) ;_ end of if    (if osm      (setvar "OSMODE" osm)    ) ;_ end of if    (foreach x loc (vla-put-lock x :vlax-true))  ) ;_ end of defun  (vl-load-com)  (setvar "CMDECHO" 0)  (setq osm (getvar "OSMODE"))  (if (zerop (getvar "WORLDUCS"))    (progn (vl-cmdf "_.UCS" "") (vl-cmdf "_.Plan" ""))  ) ;_ end of if  (setq isRus (= (getvar "SysCodePage") "ANSI_1251"))  (setq adoc (vla-get-activedocument (vlax-get-acad-object))        blks (vla-get-blocks adoc)        lays (vla-get-layers adoc)  ) ;_ end of setq  (vla-startundomark adoc)  (if isRus    (princ "\n§£§í§Ò§Ö§â§Ú§ä§Ö §à§Ò§ì§Ö§Ü§ä§í §Õ§Ý§ñ §á§à§ã§ä§â§à§Ö§ß§Ú§ñ §Ü§à§ß§ä§å§â§Ñ")    (princ "\nSelect objects for making a contour")  ) ;_ end of if  (vlax-for lay lays    (if (= (vla-get-lock lay) :vlax-true)      (progn (vla-put-lock lay :vlax-false)         	(setq loc (cons lay loc))      ) ;_ end of progn    ) ;_ end of if  ) ;_ end of vlax-for  (if (setq sel (ssget))    (progn      (setq sel (ssnamex sel))      (setq iNSpT '(0 0 0))      (setq sel (mapcar 'vlax-ename->vla-object                        (vl-remove-if 'listp (mapcar 'cadr sel))                ) ;_ end of mapcar      ) ;_ end of setq      (setq csp (vla-objectidtoobject adoc (vla-get-ownerid (car sel))))      (setq unnamed_block         	(vla-add (vla-get-blocks adoc)                      (vlax-3d-point inspt)                      "*U"         	) ;_ end of vla-add      ) ;_ end of setq      (foreach x sel        (setq oname (strcase (vla-get-objectname x)))        (cond  	((member oname '("ACDBVIEWPORT" "ACDBATTRIBUTEDEFINITION" "ACDBMTEXT" "ACDBTEXT"  )  ) ;_ end of member           	nil              )  	((= oname "ACDBBLOCKREFERENCE")           	(vla-insertblock             	unnamed_block             	(vla-get-insertionpoint x)             	(vla-get-name x)             	(vla-get-xscalefactor x)             	(vla-get-yscalefactor x)             	(vla-get-zscalefactor x)             	(vla-get-rotation x)           	) ;_ end of vla-InsertBlock           	(setq blk (cons x blk))              )              (t (setq obj (cons x obj)))        ) ;_ end of cond      ) ;_foreach      (setq lay (vla-item lays (getvar "CLAYER")))      (if (= (vla-get-lock lay) :vlax-true)        (progn (vla-put-lock lay :vlax-false)           	(setq loc (cons lay loc))        ) ;_ end of progn      ) ;_ end of if      (if obj        (progn (vla-copyobjects             	(vla-get-activedocument (vlax-get-acad-object))             	(vlax-make-variant               	(vlax-safearray-fill                 	(vlax-make-safearray                   	vlax-vbobject                   	(cons 0 (1- (length obj)))                 	) ;_ end of vlax-make-safearray                 	obj               	) ;_ end of vlax-safearray-fill             	) ;_ end of vlax-make-variant             	unnamed_block           	) ;_ end of vla-copyobjects        ) ;_ end of progn      ) ;_ end of if      (setq obj (append obj blk))      (if obj        (progn          (setq tmp_blk (vla-insertblock                          csp                          (vlax-3d-point inspt)                          (vla-get-name unnamed_block)                          1.0                          1.0                          1.0                          0.0                        ) ;_ end of vla-insertblock          ) ;_ end of setq          (vla-getboundingbox tmp_blk 'MinPt 'MaxPt)       	(setq MinPt (vlax-safearray->list MinPt)                MaxPt (vlax-safearray->list MaxPt)                DS    (max (distance MinPt (list (car MinPt) (cadr MaxPt)))                       	(distance MinPt (list (car MaxPt) (cadr MinPt)))                      ) ;_ end of max                DS    (* 0.2 DS)                  ;1/5                DS    (max DS 10)                MinPt (mapcar '- MinPt (list DS DS))                MaxPt (mapcar '+ MaxPt (list DS DS))          ) ;_ end of setq          (lib:Zoom2Lst (list MinPt MaxPt))          (setq sset (ssget "_C" MinPt MaxPt))          (if sset            (progn              (setvar "OSMODE" 0)              (setq hiden (mapcar 'vlax-ename->vla-object                                  (vl-remove-if                                    'listp                                    (mapcar 'cadr (ssnamex sset))                                  ) ;_ end of vl-remove-if                          ) ;_ end of mapcar                    hiden (vl-remove tmp_blk hiden)              ) ;_ end of setq              (mapcar '(lambda (x) (vla-put-visible x :vlax-false))                      hiden              ) ;_ end of mapcar              (setq pt (mapcar '+ MinPt (list (* 0.5 DS) (* 0.5 DS))))              (vl-cmdf "_.RECTANG" (trans MinPt 0 1) (trans MaxPt 0 1))              (setq pl (vlax-ename->vla-object (entlast)))              (setq sc (entlast))              (if                (vl-catch-all-error-p                  (vl-catch-all-apply                    '(lambda ()                   	(vl-cmdf "_-BOUNDARY" (trans pt 0 1) "")                   	(while (> (getvar "CMDACTIVE") 0) (command ""))                 	) ;_ end of lambda                  ) ;_ end of VL-CATCH-ALL-APPLY                ) ;_ end of VL-CATCH-ALL-ERROR-P             	(if isRus               	(princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â")               	(princ "\nIt was not possible to construct a contour")             	) ;_ end of if              ) ;_ end of if              (setq ec sc)              (while (setq ec (entnext ec))                (setq ret (cons (vlax-ename->vla-object ec) ret))                )                (setq ret (vl-remove pl ret))              (mapcar '(lambda (x) (vla-erase x) (vlax-release-object x))                      (list pl tmp_blk)              ) ;_ end of mapcar              (setq pl nil                    tmp_blk nil              ) ;_ end of setq              (setq                ret (mapcar '(lambda (x / mipt)                           	(vla-getboundingbox x 'MiPt nil)                                (setq MiPt (vlax-safearray->list MiPt))                           	(list MiPt x)                         	) ;_ end of lambda                            ret                    ) ;_ end of mapcar              ) ;_ end of setq              (setq ret (vl-sort ret                             	'(lambda (e1 e2)                                    (< (distance MinPt (car e1))                                   	(distance MinPt (car e2))                                    ) ;_ end of <                                  ) ;_ end of lambda                        ) ;_ end of vl-sort              ) ;_ end of setq              (setq pl  (nth 1 ret)                    ret (vl-remove pl ret)              ) ;_ end of setq              (mapcar 'vla-erase (mapcar 'cadr ret))              (mapcar '(lambda (x) (vla-put-visible x :vlax-true))                      hiden              ) ;_ end of mapcar              (foreach x loc (vla-put-lock x :vlax-true))              (if pl                (progn                  (initget "Yes No")                  (if                    (= (getkword (if isRus                               	"\n§µ§Õ§Ñ§Ý§ñ§ä§î §à§Ò§ì§Ö§Ü§ä§í?   : "                               	"\nDelete objects?   : "                             	) ;_ end of if                   	) ;_ end of getkword                   	"Yes"                    ) ;_ end of =                 	(mapcar '(lambda (x)                                (if (vlax-write-enabled-p x)                                  (vla-erase x)                                ) ;_ end of if                              ) ;_ end of lambda                         	obj                 	) ;_ end of mapcar                  ) ;_ end of if                ) ;_ end of progn                (if isRus                  (princ "\n§¯§Ö §å§Õ§Ñ§Ý§à§ã§î §á§à§ã§ä§â§à§Ú§ä§î §Ü§à§ß§ä§å§â")                  (princ "\nIt was not possible to construct a contour")                ) ;_ end of if              ) ;_ end of if            ) ;_ end of progn          ) ;_ end of if        ) ;_ end of progn      ) ;_ end of if      (vl-catch-all-apply        '(lambda ()       	(mapcar 'vlax-release-object               	(list unnamed_block tmp_blk csp blks lays)       	) ;_ end of mapcar     	) ;_ end of lambda      ) ;_ end of VL-CATCH-ALL-APPLY    ) ;_ end of progn  ) ;_if not  (foreach x loc (vla-put-lock x :vlax-true))  (setvar "OSMODE" osm)  (vla-endundomark adoc)  (vlax-release-object adoc)  (command ".area" "o" "L")(setq dt (getvar "area"))(command ".erase" L "") (writeres dt)  (princ)) ;_ end of defun;;; ========== HELPER FUNCTION ==========================================(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)  (setq pt (trans pt 0 1))  (setq VCTR  (getvar "VIEWCTR")        Y_Len (getvar "VIEWSIZE")        SSZ   (getvar "SCREENSIZE")        X_Pix (car SSZ)        Y_Pix (cadr SSZ)        X_Len (* (/ X_Pix Y_Pix) Y_Len)        Lc    (polar VCTR (dtr 180.0) (* 0.5 X_Len))        Uc    (polar Lc 0.0 X_Len)        Lc    (polar Lc (dtr 270.0) (* 0.5 Y_Len))        Uc    (polar Uc (dtr 90.0) (* 0.5 Y_Len))  ) ;_ end of setq  (if (and (> (car pt) (car Lc))       	(< (car pt) (car Uc))       	(> (cadr pt) (cadr Lc))       	(< (cadr pt) (cadr Uc))      ) ;_ end of and    t    nil  ) ;_ end of if) ;_ end of defun(defun DTR (a) (* pi (/ a 180.0)))(defun lib:pt_extents (vlist / tmp)  (setq    tmp (mapcar          '(lambda (x) (vl-remove-if 'null x))          (mapcar            '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))            '(0 1 2)          ) ;_ end of mapcar        ) ;_ end of mapcar  ) ;_setq  (list (mapcar '(lambda (x) (apply 'min x)) tmp)        (mapcar '(lambda (x) (apply 'max x)) tmp)  ) ;_ end of list) ;_defun(defun lib:Zoom2Lst (vlist / bl tr Lst OS)  (setq Lst (lib:pt_extents vlist)        bl  (car Lst)        tr  (cadr Lst)  ) ;_ end of setq  (if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))    (progn (setq OS (getvar "OSMODE"))       	(setvar "OSMODE" 0)       	(command "_.Zoom"                    "_Window"                    (trans bl 0 1)                    (trans tr 0 1)                    "_.Zoom"                    "0.95x"       	) ;_ end of command       	(setvar "OSMODE" OS)       	t    ) ;_ end of progn    NIL  ) ;_ end of if) ;_ end of defun(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))(defun WriteRes(kq / OK e data)(setq OK nil)(while (not OK)(setq e (car (entsel "\tChon text ghi ket qua:")))(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text")))(entmod (subst (cons 1 (rtos kq 2 2)) (assoc 1 (setq data (entget e))) data))(princ))

 

 

Vẫn không tính được hình này bác ạ16281_lisp_tdt.jpg


<<

Filename: 212661_eco.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 396716
Tên lệnh: ocd ocd
Hỏi Cách Lồng Lệnh Extrim Vào Lisp

Bạn tham khảo lisp này (của ai quên mất) rồi tự nghiên cứu thôi. HỌC HỎI là tốt nhưng HỌC nhiều thì tốt hơn HỎI nhiều.

 

;----- Trim and Delete outside of closed polyline (C¾t vµ xo¸ phÇn bªn ngoµi cña 1 polyline ®ãng).
; Required Express tools. OutSide Contour Delete with Extrim.
(defun C:OCD (  / en ss lst ssall bbox)
 (vl-load-com)
 (if (and (setq en (car (entsel "\nSelect contour (polyline):...
>>

Bạn tham khảo lisp này (của ai quên mất) rồi tự nghiên cứu thôi. HỌC HỎI là tốt nhưng HỌC nhiều thì tốt hơn HỎI nhiều.

 

;----- Trim and Delete outside of closed polyline (C¾t vµ xo¸ phÇn bªn ngoµi cña 1 polyline ®ãng).
; Required Express tools. OutSide Contour Delete with Extrim.
(defun C:OCD (  / en ss lst ssall bbox)
 (vl-load-com)
 (if (and (setq en (car (entsel "\nSelect contour (polyline): ")))
               (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE"))
  (progn
   (setq bbox (ACET-ENT-GEOMEXTENTS en))
   (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
   (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
   (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
   (command "_.Zoom" "0.95x")
   (if (null etrim) (load "extrim.lsp"))
   (etrim en (polar (car bbox) (angle (car bbox) (cadr bbox)) (* (distance (car bbox)(cadr bbox)) 1.1)))
   (if (and
         (setq ss (ssget "_CP" lst))
         (setq ssall (ssget "_X" (list (assoc 410 (entget en))))))
    (progn
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (foreach e1 lst (ssdel e1 ssall))
      (ACET-SS-ENTDEL ssall))))))
(princ "\nType OCD to start")
(princ)

<<

Filename: 396716_ocd_ocd.lsp
Tác giả: 0907398688
Bài viết gốc: 289763
Tên lệnh: hm trogiup 1 2 3 4 5 6 7 8 9 10 11 12 20 30 32 35 13 q1 q2 q3 q4 q5 ng e1 e2 25 dm dmt dmn kh c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 cdm cdmt cdmn ckh cq1 cq2 cq3 cq4 cq5 cng ce1 ce2 c20 c30 c32 c35 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t
Ai sửa cho em cái lisp tính diện tích trong cad 2007 với

 

********************************************************************
(defun c:HM ()
(setvar "cmdecho" 0)
 (command "units"...
>>

 

********************************************************************
(defun c:HM ()
(setvar "cmdecho" 0)
 (command "units" "2" "4" "2" "3" "" "")
 (command "-layer" "m" "2" "c" "2" "" "")
 (command "-layer" "m" "7" "c" "7" "" "")
 (command "-layer" "m" "5" "c" "5" "" "")
 (command "-layer" "m" "6" "c" "6" "" "")
 (command "-layer" "m" "4" "c" "4" "" "")
 (command "-layer" "m" "9" "c" "9" "" "")
 (command "-layer" "m" "3" "c" "3" "" "")
 (command "-layer" "m" "1" "c" "1" "" "")
 (command "-layer" "m" "8" "c" "8" "" "")
 (command "-layer" "m" "10" "c" "10" "" "")
 (command "-layer" "m" "11" "c" "11" "" "")
 (command "-layer" "m" "12" "c" "12" "" "")
 (command "-layer" "m" "30" "c" "30" "" "")
 (command "-layer" "m" "32" "c" "32" "" "")
 (command "-layer" "m" "35" "c" "35" "" "")
 (command "-layer" "m" "q1" "c" "8" "" "l" "DIACHAT1" "" "")
 (command "-layer" "m" "q2" "c" "8" "" "l" "DIACHAT2" "" "")
 (command "-layer" "m" "q3" "c" "8" "" "l" "DIACHAT3" "" "")
 (command "-layer" "m" "q4" "c" "8" "" "l" "DIACHAT4" "" "")
 (command "-layer" "m" "q5" "c" "8" "" "l" "VIEN_DA" "" "")
 (command "-layer" "m" "ng" "c" "8" "" "l" "NUOCNGAM" "" "")
 (command "-style" "VN_A3" "vntimeh.shx,vn1.shx" "2.0" "0.75" "0" "n" "n" "")
 (command "-style" "VN_A1" "vntimeh.shx,vn1.shx" "2.5" "0.75" "0" "n" "n" "")
 (command "-style" "VNH_A3" ".VnArialH" "4.5" "0.8" "0" "n" "n" "")
 (command "-style" "VNH_A1" ".VnArialH" "5.5" "0.8" "0" "n" "n" "")
  (command "-style" "DIM" "vntimeh.shx,vn1.shx" "0" "0.75" "0" "n" "n" "")
 (command "Dimdle" "1.1" ) 	 
 (command "Dimdli" "7.0" ) 	 
 (command "Dimasz" "1.1" ) 	 
 (command "Dimexe" "1.1" ) 	
 (command "Dimexo" "0" )   		
 (command "Dimblk" "ArchTick" )		
 (command "Dimcen" "1.1" ) 	
 (command "Dimtxsty" "DIM" ) 	
 (command "Dimtxt" "2.0" ) 	
 (command "Dimlfac" "1" )  		
 (command "Dimjust" "0" )		
 (command "Dimtad" "1" )		
 (command "Dimgap" "1" )		
 (command "Dimtoh" "off" )		
 (command "Dimtih" "off" )		
 (command "Dimfit" "5" )		
 (command "Dimtix" "on" )		
 (command "Dimdec" "0" ) 		
 (command "Dimtdec" "3" )		
 (command "Dimaunit" "0" )
 (command "Dimunit" "2" ) 		
 (command "Dimzin" "1" ) 		
 (command "Dimclrd" "9" )		
 (command "Dimclre" "9" )		
 (command "Dimclrt" "2" )		
 (command "Dimrnd" "0" )		
 (command "Dimtofl" "on" )		
 (command "dimstyle" "s" "TL1000_A3")
 (command "Dimdle" "1.5" ) 	 
 (command "Dimdli" "7.0" ) 	 
 (command "Dimasz" "1.5" ) 	 
 (command "Dimexe" "1.5" ) 	
 (command "Dimexo" "0" )   		
 (command "Dimblk" "ArchTick" )		
 (command "Dimcen" "1.1" ) 	
 (command "Dimtxsty" "DIM" ) 	
 (command "Dimtxt" "2.5" ) 	
 (command "Dimlfac" "10" )  		
 (command "Dimjust" "0" )		
 (command "Dimtad" "1" )		
 (command "Dimgap" "1" )		
 (command "Dimtoh" "off" )		
 (command "Dimtih" "off" )		
 (command "Dimfit" "5" )		
 (command "Dimtix" "on" )		
 (command "Dimdec" "0" ) 		
 (command "Dimtdec" "3" )		
 (command "Dimaunit" "0" )
 (command "Dimunit" "2" ) 		
 (command "Dimzin" "1" ) 		
 (command "Dimclrd" "9" )		
 (command "Dimclre" "9" )		
 (command "Dimclrt" "2" )		
 (command "Dimrnd" "0" )		
 (command "Dimtofl" "on" )		
 (command "dimstyle" "s" "TL1000_A1")	
 (command "-osnap" "end,mid,nod,int,per,nea")
 (command "pdmode" "3")
 (command "Mirrtext" "0")
 (command "Fillet" "R" "0")
 (command "Ucsicon" "off")
 (Setvar "cmdecho" 1)
(command "-layer" "s" "0" "")
(alert"    BAN DA TAO XONG LAYER,TEXT,DIM(TL100)
     *_A3 DUNG CHO BAN VE A3, *_A1 DUNG CHO BAN VE A1
            TRAN THAI HA - 0982071618!
            CHUC THANH CONG TRONG MOI CONG VIEC")
(princ "\nBan da tao xong thuoc tinh cua ban ve")
(princ)
)
(defun c:trogiup ()
(alert"    Cam on cac ban da su dung chuong trinh
     hy vong chuong trinh nay giup cac ban thanh cong
     CAC LENH TRONG CHUONG TRINH THU VIEN THUY DIEN
           TRAN THAI HA - 0982071618, 0989848565
         PHAN TRO GIUP SE DUOC UPDATE SAU")
)
;Tao cac layer
(defun c:1    () (command "layer" "make" "1" "c" 1 "" "l" "continuous" "" ""))
(defun c:2    () (command "layer" "make" "2" "c" 2 "" ""))
(defun c:3    () (command "layer" "make" "3" "c" 3 "" "l" "continuous" "" ""))
(defun c:4    () (command "layer" "make" "4" "c" 4 "" "l" "continuous" "" ""))
(defun c:5    () (command "layer" "make" "5" "c" 5 "" ""))
(defun c:6    () (command "layer" "make" "6" "c" 6 "" ""))
(defun c:7    () (command "layer" "make" "7" "c" 7 "" ""))
(defun c:8    () (command "layer" "make" "8" "c" 8 "" ""))
(defun c:9    () (command "layer" "make" "9" "c" 9 "" ""))
(defun c:10  () (command "layer" "make" "10" "c" 10 "" ""))
(defun c:11  () (command "layer" "make" "11" "c" 11 "" ""))
(defun c:12  () (command "layer" "make" "12" "c" 12 "" ""))
(defun c:20  () (command "layer" "make" "20" "c" 20 "" ""))
(defun c:30  () (command "layer" "make" "30" "c" 30 "" ""))
(defun c:32  () (command "layer" "make" "32" "c" 32 "" ""))
(defun c:35  () (command "layer" "make" "35" "c" 35 "" ""))
(defun c:13  () (command "layer" "make" "13" "c" 13 "l" "continuous" "" ""))
(defun c:q1  () (command "layer" "make" "q1" "c" 8 "" "l" "DIACHAT1" "" ""))
(defun c:q2  () (command "layer" "make" "q2" "c" 8 "" "l" "DIACHAT2" "" ""))
(defun c:q3  () (command "layer" "make" "q3" "c" 8 "" "l" "DIACHAT3" "" ""))
(defun c:q4  () (command "layer" "make" "q4" "c" 8 "" "l" "DIACHAT4" "" ""))
(defun c:q5  () (command "layer" "make" "q5" "c" 8 "" "l" "VIEN_DA" "" ""))
(defun c:ng  () (command "layer" "make" "ng" "c" 8 "" "l" "NUOCNGAM" "" ""))
(defun c:e1  () (command "layer" "make" "e1" "c" 42 "" "l" "Ton" "" ""))
(defun c:e2  () (command "layer" "make" "e2" "c" 42 "" "l" "FENCELINE1" "" ""))
(defun c:25    () (command "layer" "make" "25" "c" 25 "" "l" "continuous" "" ""))

(defun c:dm   () (command "layer" "make" "dimension" "c" 9 "" ""))
(defun c:dmt  () (command "layer" "make" "dmt" "c" 3 "" ""))
(defun c:dmn  () (command "layer" "make" "dmn" "c" 8 "" ""))
(defun c:kh   () (command "layer" "make" "kh" "c" 11 "" ""))

(defun c:c0   () (ssget) (command "change" "p" "" "p" "la" "0" "c" "bylayer" ""))
(defun c:c1   () (ssget) (command "change" "p" "" "p" "la" "1" "c" "bylayer" ""))
(defun c:c2   () (ssget) (command "change" "p" "" "p" "la" "2" "c" "bylayer" ""))
(defun c:c3   () (ssget) (command "change" "p" "" "p" "la" "3" "c" "bylayer" ""))
(defun c:c4   () (ssget) (command "change" "p" "" "p" "la" "4" "c" "bylayer" ""))
(defun c:c5   () (ssget) (command "change" "p" "" "p" "la" "5" "c" "bylayer" ""))
(defun c:c6   () (ssget) (command "change" "p" "" "p" "la" "6" "c" "bylayer" ""))
(defun c:c7   () (ssget) (command "change" "p" "" "p" "la" "7" "c" "bylayer" ""))
(defun c:c8   () (ssget) (command "change" "p" "" "p" "la" "8" "c" "bylayer" ""))
(defun c:c9   () (ssget) (command "change" "p" "" "p" "la" "9" "c" "bylayer" ""))
(defun c:c10 () (ssget) (command "change" "p" "" "p" "la" "10" "c" "bylayer" ""))
(defun c:c11 () (ssget) (command "change" "p" "" "p" "la" "11" "c" "bylayer" ""))
(defun c:c12 () (ssget) (command "change" "p" "" "p" "la" "12" "c" "bylayer" ""))
(defun c:c13 () (ssget) (command "change" "p" "" "p" "la" "13" "c" "bylayer" ""))
(defun c:cdm  () (ssget) (command "change" "p" "" "p" "la" "dimension" "c" "bylayer" ""))
(defun c:cdmt () (ssget) (command "change" "p" "" "p" "la" "dmt" "c" "bylayer" ""))
(defun c:cdmn () (ssget) (command "change" "p" "" "p" "la" "dmn" "c" "bylayer" ""))
(defun c:ckh  () (ssget) (command "change" "p" "" "p" "la" "kh" "c" "bylayer" ""))
(defun c:cq1  () (ssget) (command "change" "p" "" "p" "la" "q1" "c" "bylayer" ""))
(defun c:cq2  () (ssget) (command "change" "p" "" "p" "la" "q2" "c" "bylayer" ""))
(defun c:cq3  () (ssget) (command "change" "p" "" "p" "la" "q3" "c" "bylayer" ""))
(defun c:cq4  () (ssget) (command "change" "p" "" "p" "la" "q4" "c" "bylayer" ""))
(defun c:cq5  () (ssget) (command "change" "p" "" "p" "la" "q5" "c" "bylayer" ""))
(defun c:cng  () (ssget) (command "change" "p" "" "p" "la" "ng" "c" "bylayer" ""))
(defun c:ce1  () (ssget) (command "change" "p" "" "p" "la" "e1" "c" "bylayer" ""))
(defun c:ce2  () (ssget) (command "change" "p" "" "p" "la" "e2" "c" "bylayer" ""))
(defun c:c20  () (ssget) (command "change" "p" "" "p" "la" "20" "c" "bylayer" ""))
(defun c:c30  () (ssget) (command "change" "p" "" "p" "la" "30" "c" "bylayer" ""))
(defun c:c32  () (ssget) (command "change" "p" "" "p" "la" "32" "c" "bylayer" ""))
(defun c:c35  () (ssget) (command "change" "p" "" "p" "la" "35" "c" "bylayer" ""))

(defun c:t1   () (command "layer" "off" "1" ""))
(defun c:t2   () (command "layer" "off" "2" ""))
(defun c:t3   () (command "layer" "off" "3" ""))
(defun c:t4   () (command "layer" "off" "4" ""))
(defun c:t5   () (command "layer" "off" "5" ""))
(defun c:t6   () (command "layer" "off" "6" ""))
(defun c:t7   () (command "layer" "off" "7" ""))
(defun c:t8   () (command "layer" "off" "8" ""))
(defun c:t9   () (command "layer" "off" "9" ""))
(defun c:t10 () (command "layer" "off" "10" ""))
(defun c:t11 () (command "layer" "off" "11" ""))
(defun c:t12 () (command "layer" "off" "12" ""))
(defun c:t13 () (command "layer" "off" "13" ""))
(defun c:tq1   () (command "layer" "off" "q1" ""))
(defun c:tq2   () (command "layer" "off" "q2" ""))
(defun c:tq3   () (command "layer" "off" "q3" ""))
(defun c:tq4   () (command "layer" "off" "q4" ""))
(defun c:tq5   () (command "layer" "off" "q5" ""))
(defun c:tng   () (command "layer" "off" "ng" ""))
(defun c:te1   () (command "layer" "off" "e1" ""))
(defun c:te2   () (command "layer" "off" "e2" ""))
(defun c:t30   () (command "layer" "off" "30" ""))
(defun c:t20   () (command "layer" "off" "20" ""))
(defun c:t32   () (command "layer" "off" "32" ""))
(defun c:t35   () (command "layer" "off" "35" ""))

(defun c:tdm  () (command "layer" "off" "dimension" ""))
(defun c:tdmt () (command "layer" "off" "dmt" ""))
(defun c:tdmn () (command "layer" "off" "dmn" ""))

(defun c:da   () (command "attedit" "" "" "" ""))
(defun c:`  () (command "zoom" "2x"))
(defun c:`` () (command "zoom" "0.5x"))
(defun c:+  () (command "zoom" "5x"))
(defun c:++ () (command "zoom" "10x"))
(defun c:-  () (command "zoom" "0.2x"))
(defun c:-- () (command "zoom" "0.1x"))
(defun c:zc () (command "'.zoom" "0.8x"))
(defun c:zz () (command "'.zoom" "1.2x"))
(defun c:zz () (command "'.zoom" "p"))
(defun c:ze () (command "'.zoom" "e"))
(defun c:zv () (command "'.zoom" "v"))
(defun c:zd () (command "'.zoom" "d"))

;Kichthuoc
(defun c:d1 () (command "dimlinear"))
(defun c:d2 () (command "dimaligned"))
(defun c:d3 () (command "dimangular"))
(defun c:d4 () (command "dimradius"))
(defun c:d5 () (command "dimdiameter"))
(defun c:dd () (command "dimcontinue"))

(defun c:xx () (command "xline"))
(defun c:sd () (command "spline"))
(defun c:mm () (command "matchprop"))
(defun c:ll () (command "qleader"))

(defun c:goc ()
  (setvar "cmdecho" 0)
  ;(setq osm (getvar "osmode"))
  (if (= sc nil)(setq sc (getreal (strcat"\nChon ty le ve (=kt ve/kt Autocad):"))))
  (prompt "\n*****Chu y: Ty le hien tai la*****:")(princ sc)
  ;(if (/= sc2 nil)(setq sc sc2))
  (command ".zoom" "e")
  (setq sspl (SSGET "c" '(10.5 20.25) '(10.5 27.5) (LIST(CONS 0 "lwpolyline"))));su dung khi ban ve co 1 cn o toa do co dinh
  (if (= th nil) (setq th (ssget "w" '(10.5 19.25 0) '(11.5 18.00 0) (list(cons 0 "TEXT")))))
  (command "zoom" "p")
  (if (and (= a nil)(/= sspl nil))(setq a (cdr(assoc 10 (entget (ssname sspl 0))))))
  (IF (= a nil)
    (setq a (Getpoint "\n Chon mot diem lam chuan (co cao do):"))
    (progn
      (setq kitu nil)
      (initget "Co Khong")
      (setq kitu (getkword "\n Ban co chon lai diem chuan khong?:<K>"))
      (If (= kitu "Co")(setq a (Getpoint "\n Chon lai diem lam chuan (co cao do):")))
      )
    )

  (if (and(= nil g)(/= nil th)) (setq g (atof (cdr (ASSOC 1 (ENTGET (SSNAME th 0)))))))
  (IF (= nil g)
    (progn
      (prompt "Khong co cao do tai vi tri can tim!")
      (setq g (Getreal "\n Nhap cao do diem chuan :<Chon>" ))
      (if (= nil g)
	(progn
	  (setq sscd (entsel "\n Moi ban chon cao do tren man hinh:"))
	  (setq g (atof (cdr (assoc 1 (entget (car sscd))))))
	  )
	)
      )
    (If(= kitu "Co")
      (progn
	(setq g (Getreal "\n Nhap lai cao do diem chuan :<Chon>" ))
	(if (= nil g)
	  (progn
	    (setq sscd (entsel "\n Moi ban chon lai cao do tren man hinh:"))
	    (setq g (atof (cdr (assoc 1 (entget (car sscd))))))
	    )
	  )
	)
      )
    )
  )


;;; ********************** Dieu chinh Goc Quay giao dien ****************

(DEFUN C:S45 ()
     (COMMAND "'SNAP" "R" "0,0" "45")
     (COMMAND "'SNAP" "OFF"))

(DEFUN C:S60 ()
     (COMMAND "SNAP" "R" "0,0" "60")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S30 ()
     (COMMAND "SNAP" "R" "0,0" "30")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:00 ()
     (COMMAND "SNAP" "R" "0,0" "0")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S15 ()
     (COMMAND "SNAP" "R" "0,0" "15")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S75 ()
     (COMMAND "SNAP" "R" "0,0" "75")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S10 ()
     (COMMAND "SNAP" "R" "0,0" "10")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S20 ()
     (COMMAND "SNAP" "R" "0,0" "20")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S40 ()
     (COMMAND "SNAP" "R" "0,0" "40")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S50 ()
     (COMMAND "SNAP" "R" "0,0" "50")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S70 ()
     (COMMAND "SNAP" "R" "0,0" "70")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S80 ()
     (COMMAND "SNAP" "R" "0,0" "80")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S90 ()
     (COMMAND "SNAP" "R" "0,0" "90")
     (COMMAND "SNAP" "OFF"))

(DEFUN C:S100 ()
     (COMMAND "SNAP" "R" "0,0" "100")
     (COMMAND "SNAP" "OFF"))

;;;=========== Thay doi do rong polyline ========
(DEFUN C:PW (/ SSET SSL M WID I)
   (PRINC "\nSelect polylines :")
   (SETQ SSET (SSGET))
   (IF (/= NIL SSET) (PROGN
   (SETQ SSL (SSLENGTH SSET))
   (INITGET 4 "")
   (SETQ WID (GETREAL "\nNew width : "))
   (IF (/= WID NIL) 
      (PROGN  		
   	(SETQ I 0)
   	(WHILE (< I SSL)
       	  (SETQ M (ENTGET (SSNAME SSET I)))
          (IF (= (CDR (ASSOC '0 M)) "POLYLINE") 
              (PROGN
               (SETQ M (SUBST (CONS 40 WID) (ASSOC 40 M) M))
               (SETQ M (SUBST (CONS 41 WID) (ASSOC 41 M) M))
	       (ENTMOD M)
              )
          ) 
          (SETQ I (+ I 1))
        )  
      )
   )))  
   (PRINC)
)

;; ================*********** Lock layer ************==========================

(DEFUN C:LK (/ SSET SSL ENT LAY I MODE)
   (SETQ SSET (SSGET))
   (IF (/= NIL SSET) 
    (PROGN
     (SETQ SSL (SSLENGTH SSET))
     (SETQ LAY "")
     (SETQ I 0)
     (SETQ MODE 0) 
     (WHILE (< I SSL)
       	  (SETQ ENT (ENTGET (SSNAME SSET I)))
	  (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
          (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) ))
          (SETQ I (+ I 1))
     )
     (COMMAND "LAYER" "LOCK" LAY "")
     (IF (= MODE 1) (COMMAND "") )
    )
   )
   (PRINC)
)
;; ================ UnLock layer ==========================
;;;---------------------------------------------------------
(DEFUN C:UL (/ SSET SSL ENT LAY I MODE)
   (SETQ SSET (SSGET))
   (IF (/= NIL SSET) 
    (PROGN
     (SETQ SSL (SSLENGTH SSET))
     (SETQ LAY "")
     (SETQ I 0)
     (SETQ MODE 0) 
     (WHILE (< I SSL)
       	  (SETQ ENT (ENTGET (SSNAME SSET I)))
	  (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
          (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) ))
          (SETQ I (+ I 1))
     )
     (COMMAND "LAYER" "UNLOCK" LAY "")
     (IF (= MODE 1) (COMMAND "") )
    )
   )
   (PRINC)
)
************************************************
(Defun C:TRM()
	(prompt "\n This defun was rewriten by Eng.Tran Thai Ha .\n Thank you for using.")
	(Setq p1 (GetPoint "\n Mut thu 1 cua duond sinh:"))
	(Setq p2 (GetPoint "\n Mut thu 2 cua duong sinh:"))
	(Setq d (Distance p1 p2))
	(Setq g (Angle p1 p2))
      (If (not b0) 
        (Setq b0 10.0)
      )
        (Setq b (GetDist (Strcat"\n Chieu rong trai mai <"(rtos b0)">:")))
      (If b
        (Setq b0 b)	
        (Setq b b0)
      )
     (If (not c0) 
        (Setq c0 1.0)
     )
        (Setq c (GetDist (Strcat"\n Khoang cach giua 2 duong <"(rtos c0)">:")))
     (If c
        (Setq c0 c)
        (Setq c c0)
     )
        (Setq a c)
        (Setq l p1)
	(Setq l1 (Polar l g d))
	(Setq l2 (Polar l (+ g 1.5708) c))
        (Setq l3 (Polar l2 g (* d 0.35)))
	(Command "._LINE" l l1 "")
	(Command "._LINE" l2 l3 "")
	(Command "._CHPROP" (EntLast) "" "C" "5" "")
        (Setq n (fix (/ b (* 2 c))))
       (Repeat n 
		(Setq l (Polar l (+ g 1.5708) (* 2 c)))
		(Setq l1 (Polar l g d))
		(Setq l2 (Polar l (+ g 1.5708) c))
                (Setq l3 (Polar l2 g (* d 0.35)))
                (Setq a (+ a (* 2 c)))
                (Command "._LINE" l l1 "")
                (Command "._LINE" l2 l3 "")
		(Command "._CHPROP" (EntLast) "" "C" "5" "")
      )
	(Entdel(Entlast))
)
******************************************************
(Defun C:TRB()
 	(prompt "\n This defun was rewriten by Eng.Tran Thai Ha.\n Thank you for using.")
	(Setq p1 (GetPoint "\n Mut thu 1 cua duong sinh:"))
	(Setq p2 (GetPoint "\n Mut thu 2 cua duong sinh:"))
	(Setq d (Distance p1 p2))
	(Setq g (Angle p1 p2))
      (If (not b0) 
        (Setq b0 10.0)
      )
        (Setq b (GetDist (Strcat"\n Chieu rong trai bong <"(rtos b0)">:")))
      (If b
        (Setq b0 b)	
        (Setq b b0)
      )
     (If (not c0) 
        (Setq c0 1.0)
     )
        (Setq c (GetDist (Strcat"\n Khoang cach nho nhat giua hai duong <"(rtos c0)">:")))
     (If c
        (Setq c0 c)	
        (Setq c c0)
     )
        (Setq a c)
        (Setq l p1)
	(While (< a b) 
		(Setq l (Polar l (+ g 1.5708) c))
		(Setq l1 (Polar l g d))
		(Setq c (* c 1.15))
		(Setq a (+ a c))
                (Command "._LINE" l l1 "")
       )
)
;------------------------------------------------------------------------------

;-------------------------------------------------------------------------------
(defun chgnum1 (objs / last_o tot_o ent o_str n_str st s_temp
                       n_slen o_slen si chf chm cont ans)
  (setq chm 0)
  (if objs
    (progn
        (if (= (sslength objs) 1)
          (progn
            (setq ent (entget (ssname objs 0)))
          )
        )
      (setq o_str (cdr (assoc 1 ent)))
      (if o_str	
      (progn
      (setq o_slen (strlen o_str))
      (if (/= o_slen 0)
        (progn
	  (setq text (rtos (setq sobicong (+ (atof o_str) socong)) 2 2))
          (setq n_str text)
          (setq n_slen (strlen n_str))
          (setq last_o 0
                tot_o  (if (= (type objs) 'ENAME)
                         1
                         (sslength objs)
                       )
          )
          (while (< last_o tot_o)
            (if (or (= "MTEXT"
                       (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
                    (= "TEXT"
                       (cdr (assoc 0 (setq ent (entget (ssname objs last_o)))))))
              (progn
                (setq chf nil si 1)
                (setq s_temp (cdr (assoc 1 ent)))
                (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
                  (if (= st o_str)
                    (progn
                      (setq s_temp (strcat
                                     (if (> si 1)
                                       (substr s_temp 1 (1- si))
                                       ""
                                     )
                                     n_str
                                     (substr s_temp (+ si o_slen))
                                   )
                      )
                      (setq chf t)
                      (setq si (+ si n_slen))
                    )
                    (setq si (1+ si))
                  )
                )
                (if chf
                  (progn
                    (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
                    (setq chm (1+ chm))
                  )
                )
              )
            )
            (setq last_o (1+ last_o))
          )
        )
      )
      )
      )
    )
  )
)

;-------------------------------------------------------------------------------
;				  THAN CHUONG TRINH
;-------------------------------------------------------------------------------
(defun c:sum()
	(setq socong (getreal "\nCong voi : "))
	(prompt "\nChon so de cong :")
	(setq sset (ssget))
	(if (null sset)
		(progn
			(princ "\nERROR: Nothing selected !")
		)
		(progn
			(setq sslen (sslength sset))
			(setq cht_ot (getvar "texteval"))
			(setvar "texteval" 1)
			(while (> sslen 0)
				(redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 4)
				(setq ss (ssadd))
			        (ssadd (ssname sset sslen) ss)
			        (chgnum1 ss)
			        (redraw sn 1)
			)
			(setvar "texteval" cht_ot)
		)
	)
	(if cht_oe (setq *error* cht_oe))   ; Reset old error function if error
	(eval(read U:E))
	(if cht_ot (setvar "texteval" cht_ot))
	(if cht_oh (setvar "highlight" cht_oh))
	(if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing
	(setq sset nill)
)
;------------------------------------------------------------------------------ 
;-------------------------------------------------------------------------------

;-------------------------------------------------------------------------------
(defun chgnum2 (objs / last_o tot_o ent o_str n_str st s_temp
                       n_slen o_slen si chf chm cont ans)
  (setq chm 0)
  (if objs
    (progn
        (if (= (sslength objs) 1)
          (progn
            (setq ent (entget (ssname objs 0)))
          )
        )
      (setq o_str (cdr (assoc 1 ent)))
      (if o_str	
      (progn
      (setq o_slen (strlen o_str))
      (if (/= o_slen 0)
        (progn
	  (setq text (rtos (setq sobinhan (* (atof o_str) sonhan)) 2 2))
          (setq n_str text)
          (setq n_slen (strlen n_str))
          (setq last_o 0
                tot_o  (if (= (type objs) 'ENAME)
                         1
                         (sslength objs)
                       )
          )
          (while (< last_o tot_o)
            (if (or (= "MTEXT"
                       (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
                    (= "TEXT"
                       (cdr (assoc 0 (setq ent (entget (ssname objs last_o)))))))
              (progn
                (setq chf nil si 1)
                (setq s_temp (cdr (assoc 1 ent)))
                (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
                  (if (= st o_str)
                    (progn
                      (setq s_temp (strcat
                                     (if (> si 1)
                                       (substr s_temp 1 (1- si))
                                       ""
                                     )
                                     n_str
                                     (substr s_temp (+ si o_slen))
                                   )
                      )
                      (setq chf t)
                      (setq si (+ si n_slen))
                    )
                    (setq si (1+ si))
                  )
                )
                (if chf
                  (progn
                    (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
                    (setq chm (1+ chm))
                  )
                )
              )
            )
            (setq last_o (1+ last_o))
          )
        )
      )
      )
      )
    )
  )
)
;-------------------------------------------------------------------------------
;				  THAN CHUONG TRINH
;-------------------------------------------------------------------------------
(defun c:mul()
	(setq sonhan (getreal "\nNhan voi: "))
	(prompt "\nChon so de nhan:")
	(setq sset (ssget))
	(if (null sset)
		(progn
			(princ "\nERROR: Nothing selected !")
		)
		(progn
			(setq sslen (sslength sset))
			(setq cht_ot (getvar "texteval"))
			(setvar "texteval" 1)
			(while (> sslen 0)
				(redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 4)
				(setq ss (ssadd))
			        (ssadd (ssname sset sslen) ss)
			        (chgnum2 ss)
			        (redraw sn 1)
			)
			(setvar "texteval" cht_ot)
		)
	)
	(if cht_oe (setq *error* cht_oe))   ; Reset old error function if error
	(eval(read U:E))
	(if cht_ot (setvar "texteval" cht_ot))
	(if cht_oh (setvar "highlight" cht_oh))
	(if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing
	(setq sset nill)
)

;; ================ quay doi duong ==========================
;;;---------------------------------------------------------
(defun c:90 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "90"))
(defun c:-90 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "-90"))
(defun c:45 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "45"))
(defun c:-45 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "-45"))
(defun c:30 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "30"))
(defun c:-30 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "-30"))
(defun c:60 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "60"))
(defun c:-60 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "-60"))
(defun c:180 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "180"))
(defun c:-180 (/ ss1)
  (setq ss1 (ssget))(command "rotate" ss1 "" pause "-180"))


;; ================ copy va quay ==========================
;;;---------------------------------------------------------

;;;---------------------------------------------------------------------------;
;;;---------------------------------------------------------------------------;

(defun croerr (s)                     ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (if (/= s "Function cancelled") 
    (princ (strcat "\nError: " s))
  ) 
  (setq S nil)                        ; Free selection-set if any
  (setvar "CMDECHO" cm)               ; Restore saved mode
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
)

;;;---------------------------------------------------------------------------;
;;; (lastent)  - Find the very last entity in the database.  This function will
;;;              return the entity name of the last database entity (including
;;;              sub-entities).
;;;---------------------------------------------------------------------------;

(defun lastent (/ a b)
  (if (setq a (entlast))
    (while (setq b (entnext a))
      (setq a b)
    )
  )
  a
)
;;;---------------------------------------------------------------------------;
;;; (redss ss) - Redraw selection set.  This function redraws every entity in
;;;              the selection set ss that is passed to it.
;;;---------------------------------------------------------------------------;

(defun redss (ss / en i)
  (setq i 0)
  (while (setq en (ssname ss i))
    (redraw en 1)
    (setq i (1+ i))
  )
)

;;;---------------------------------------------------------------------------;
;;; (lss en)   - Last selection set.  This function returns a selection set
;;;              comprised of all entities that have been added to the data-
;;;              base since entity en was created.  The entity name en is passed
;;;              to lss when it is called.
;;;---------------------------------------------------------------------------;

(defun lss (en / sels ed)
  (setq sels (ssadd))                 ; Create new selection set
  (while (/= en nil)
    (if (setq en (entnext en)) (setq ed (entget en))) ; Get next entity
    (if (/= en nil) (setq sels (ssadd en sels))) ; Add entity to database

    ;; Ignore Polyline and Insert sub-entities (only include main entities)

    (if (or (= (cdr (assoc 0 ed)) "Polyline")
            (= (cdr (assoc 0 ed)) "Insert")
        )
      (while (/= (cdr (assoc 0 (entget (setq en (entnext en))))) "Seqend"))
    )
  )
  sels                                ; Return new selection set
)
;;;---------------------------------------------------------------------------;
;;; Main Program.
;;;---------------------------------------------------------------------------;

(defun c:CR(/ olderr cm loop ss1 ss2 bp mult lent ss2 lp1 lp2)
  (setq olderr *error*                ; Save old error handler
        *error* croerr)
  (setq cm (getvar "cmdecho"))        ; Save cmdecho setting
  (setvar "cmdecho" 0)                ; Turn off command echoes
  (setq loop t)                       ; Ensure we go through loop once
  (while (not (setq ss1 (ssget))))    ; SS1 = objects to be copied/rotated
  (initget 1 "Multiple")
  (setq bp (getpoint "\nBase point or displacement>/Multiple: "))
  (if (= bp "Multiple")

    ;; Multiple selected, get copy base point and set flag mult so that we
    ;; will continue indefinately through loop.

    (progn
      (setq bp (getpoint "\nBase point: "))
      (setq mult t)
    )
  )

  (while loop
    (setq loop mult)                  ; Once through or forever if "multiple"
    (setq lent (lastent))             ; Store last entity in db before copy
    (command ".copy" ss1 "" bp bp)     ; Copy entities on top of themselves
    (setq ss2 (lss lent))             ; SS2 now contains new entities created
    (setq lp1 (getvar "lastpoint"))   ; For displacement option check later
    (prompt "\nSecond point of displacement: ")
    (command ".move" ss2 "" bp pause)  ; Move the new entities
    (setq lp2 (getvar "lastpoint"))   ; For displacement option check later
    (redss ss1)                       ; Redraw the selection set

    ;; Displacement value was given so now get rotation point

    (if (and (not mult)               ; Only do this for single copy/rotate
             (= (distance lp1 lp2) 0) ; If equal, displacement option is used
        )
      (setq lp2 (getpoint "\nRotation Point: "))
    )

    (if mult
      (prompt "\nRotation angle ")
      (prompt "\nReference/<Rotation angle>: ")
    )
    (command ".rotate" ss2 "" lp2 pause)
  )
  (setvar "CMDECHO" cm)               ; Restore saved mode
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)                             ; Exit quietly
)

(princ "\n\tCR (copy/rotate) loaded.  Start command with CR.")

*********************************************************************
(defun c:MD()
  (setq goc nil lmd nil lmn nil dmd nil pm nil )

 (command "layer" "make" "2" "c" "2" "" "")
 (command "layer" "make" "5" "c" "5" "" "")
  (setq goc (getpoint"\nNhap diem bat dau: "))
  (if goc null (setq goc (list 0 0)))
  (command "ucs" "_o" (setq goc goc))
    (setq lmd (getreal"\nNhap chieu dai mai doc <m>: "))
    (setq lmn (/ lmd 2.5))
    (setq dmd (getreal"\nNhap khoang cach mai doc <m>: "))
  (command "-layer" "s" "5" "")
  (command "line" 
                         (setq pm (list 0 0))
                         (setq pm (list 0 lmd)) "")
  (command "line"
                         (setq pm (list (* 2 dmd) 0))
	   (setq pm (list (* 2 dmd) lmd)) "")
  (command "line"
	   (setq pm (list (* 4 dmd) 0))
	   (setq pm (list (* 4 dmd) lmd)) "")
  (command "-layer" "s" "2" "")
  (command "line"
	   (setq pm (list (* 1 dmd) 0))
	   (setq pm (list (* 1 dmd) lmn)) "")
  (command "line"
	   (setq pm (list (* 3 dmd) 0))
	   (setq pm (list (* 3 dmd) lmn)) "")
  (command "-osnap" "end,mid,nod,int,per,nea")
  (command "ucs" "w" "")
  (command "-layer" "s" "0" "")
)
***********************************************************
;CHAMFER
(defun c:cf () (command "chamfer"))
(defun c:cfd () (command "chamfer" "d"))
(defun c:cf0 () (command "chamfer" "d" "0" ""))
;FILLET
(defun c:f () (command "fillet"))
(defun c:fr () (command "fillet" "r"))
(defun c:f0 () (command "fillet" "r" "0" ""))
;COPY
(defun c:c () (command "copy"))
(defun c:cp () (command "copy"))
(defun c:cm () (ssget) (command "copy" "p" "" "m"))
;TRIM
(defun c:tr () (command "trim"))
(defun c:tf () (ssget) (command "trim" "p" "" "f"))

(defun c:CCR () (command "circle" "r"))
(defun c:cv () (command "circle" "2p"))
(defun c:ctt () (command "circle" "ttr"))


(defun c:ef (/ a)
  (setq a (ssget))(command "extend" a "" "f"))

(defun c:cl() 
	(ssget)
	(setq ncol (getint "so cot: "))
	(setq acol (getdist "khoang cach: "))
	(command "_array" "p" "" "r" 1 ncol acol "")
)
(defun c:rw() 
	(ssget)
	(setq nrow (getint "so hang: "))
	(setq arow (getdist "khoang cach: "))
	(command "_array" "p" "" "r" nrow 1 arow "")
)

; *************************************************************************
; sua kich thuoc cua dim khi chua chuan ( do sai so hoac muon lam cho chan)
(defun c:df ()
 (prompt "\nchon duong kich thuoc muon thay doi dong text")
 (setq a (entsel))
 (prompt "\n")
 (setq b (entget (car a)))
 (setq d (assoc 1 b))
 (prompt "\nexisting text = ")(princ d)
 (prompt "\nnew text = ")
 (setq e (getstring 1))
 (setq d1 (cons (car d) e))
 (setq b1 (subst d1 d b))
 (entmod b1)
 (prompt "\n"))
; ************************************************************************
; Tra ve gia tri dung ban dau cua DIMENSION (bi sai do nguoi ve can thiep)

(DEFUN C:fd (/ ha ha1 ha2 ha3 ha4 dodai n)
 (setq ha1 (ssget '((0 . "DIMENSION"))))
 (IF (null ha1) (princ "\nNone dimension found")
  (progn
   (setq dodai (sslength ha1))
   (setq n 0)
   (repeat dodai
    (setq ha (ssname ha1 n))
    (setq ha2 (entget ha))
    (setq ha3 (assoc 1 ha2))
    (setq ha4 (subst (cons 1 "") ha3 ha2))
    (entmod ha4)
    (setq n (1+ n))
   )
  )
 )
 (princ)
)
; ***********************************************************
; tinh dien tich 1 vung kin bat ky ( co the tinh theo ty le) 
(Defun c:ae()
	(setvar "cmdecho" 0)
	(command "osnap" "none")
	(initget "Heso Do")
	(setq pt (getpoint "\n He so / <Chon diem trong vung can tinh dien tich>:"))
   	(if (= pt "Heso")
	    	(progn	
			(setq am (getreal "Cho he so thay doi dien tich:"))
			(if (and (null am) (/= ac 0))
				(setq am ac)
			)
		(setq pt (getpoint "\n Chon diem trong vung can tinh dien tich: ")))
		(setq ac am))
			
	(if (or (= am 0) (null am)) (setq am 1))
	(setq s 0)
	(progn 
;		(setq pt (getpoint "\n Chon diem trong vung can tinh dien tich: "))	
	      (while pt
			(setq entold (cdr (assoc 5 (entget (entlast)))))
			(command "boundary" pt "")
			(setq entnew (cdr (assoc 5 (entget (entlast)))))
			(if (/= entold entnew)    
				(progn 
                        	(setq entnew (entget (entlast)))
                        	(if (assoc 62 entnew)
                          		(setq entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew)))) (assoc 62 entnew) entnew))
                          		(setq entnew (append entnew (list (cons 62 (+ 3 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 entnew))))))))))                          	)
				                          
                        	(entmod entnew)
                        	(Command "area" "o" (entlast))
					(setq s (+ s (getvar "area")))
   					(setq pt (getpoint "\n Chon diem trong vung can tinh dien tich: "))
(entdel (entlast)))
				(progn
					(princ "chon diem sai")
					(setq pt (getpoint "\n Chon diem trong vung can tinh dien tich: "))))))
	
	(command "osnap" "intersection")
	(princ (* s am))
        (princ))


(defun c:k ()
    (setvar "cmdecho" 0)
    (setq olderr *error* *error* myerror)
    (prompt "\nHay chon dong TEXT !... ")
    (prompt "\nSelect objects: ")
    (command "select" "au" pause)
    (setq sstxt (ssget "p")
          sslen (sslength sstxt)
          ctr 0 )
(command ".undo" "mark")
    (while (< ctr sslen)
           (setq listxt (entget (ssname sstxt ctr))
                 txttxt (cdr (assoc 1 listxt))
                 enttxt (cdr (assoc 0 listxt)))
           (if (= enttxt "TEXT")
               (progn
                   (setq testxt (substr txttxt 1 3))
                   (if (or (= testxt "%%u") (= testxt "%%U"))
                       (setq newtxt (substr txttxt 4))
                       (setq newtxt (strcat "%%u" txttxt)))
                   (setq listxt (subst (cons 1 newtxt) (assoc 1 listxt) listxt))
                   (entmod listxt)))
            (setq ctr (1+ ctr)))
    (setq *error* olderr)
    (setvar "cmdecho" 1)
    (princ))
;*******************************************************************************
(DEFUN C:CD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
                PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
      *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
    (PROGN
	(SETQ DS (ENTGET (SSNAME SS DEM)))
	(SETQ KDL (CDR (ASSOC 0 DS)))
	(IF (= "DIMENSION" KDL)
	   (PROGN
		(SETQ PT10 (CDR (ASSOC 10 DS)))
		(SETQ PT11 (CDR (ASSOC 11 DS)))
		(SETQ PT13 (CDR (ASSOC 13 DS)))
		(SETQ PT14 (CDR (ASSOC 14 DS)))
		(SETQ N70 (CDR (ASSOC 70 DS)))
		(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
		   (PROGN
			(SETQ GOCY (ANGLE PT10 PT14))
			(SETQ GOCX (+ GOCY (/ PI 2)))
		   )
		)
		(SETVAR "OSMODE" 0)
		(SETQ PTI (POLAR PT GOCX 2))
		(SETQ PT13I (POLAR PT13 GOCY 2))
		(SETQ PT14I (POLAR PT14 GOCY 2))
		(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
		(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
		(SETQ O13 (ASSOC 13 DS))
		(SETQ O14 (ASSOC 14 DS))
		(SETQ N13 (CONS 13 PT13N))
		(SETQ N14 (CONS 14 PT14N))
		(SETQ DS (SUBST N13 O13 DS))
		(SETQ DS (SUBST N14 O14 DS))
		(ENTMOD DS)
	   )
	)
	(SETQ DEM (+ DEM 1))
    )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)               ; Restore old *error* handler
(PRINC)
)
;******************************************************************************

(DEFUN C:BD (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
                PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
      *error* myerror)
(PRINC "chon doi tuong kt muon chuyen song song!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Diem moc can song song:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
    (PROGN
	(SETQ DS (ENTGET (SSNAME SS DEM)))
	(SETQ KDL (CDR (ASSOC 0 DS)))
	(IF (= "DIMENSION" KDL)
	   (PROGN
		(SETQ PT13 (CDR (ASSOC 13 DS)))
		(SETQ PT14 (CDR (ASSOC 14 DS)))
		(SETQ PT10 (CDR (ASSOC 10 DS)))
		(SETQ PT11 (CDR (ASSOC 11 DS)))
		(SETQ N70 (CDR (ASSOC 70 DS)))
		(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
		   (PROGN
			(SETQ GOCY (ANGLE PT10 PT14))
			(SETQ GOCX (+ GOCY (/ PI 2)))
		   )
		)
		(SETVAR "OSMODE" 0)
		(SETQ PTI (POLAR PT GOCX 2))
		(SETQ PT10I (POLAR PT10 GOCY 2))
		(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
		(SETQ KC (DISTANCE PT10 PT10N))
		(SETQ O10 (ASSOC 10 DS))
		(SETQ N10 (CONS 10 PT10N))
		(SETQ DS (SUBST N10 O10 DS))
		(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
		(SETQ O11 (ASSOC 11 DS))
		(SETQ N11 (CONS 11 PT11N))
		(SETQ DS (SUBST N11 O11 DS))
		(ENTMOD DS)
	   )
	)
	(SETQ DEM (+ DEM 1))
    )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)

;;;Viet boi 
;*********************************************************************
(defun ketthuc ()
	(setvar	"cmdecho"	luuecho)
	(setq *error*	luu
		luu		nil	
		luuecho	nil
	);setq
	(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:cct ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(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)) 	
		)
	)
);
(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
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

(defun c:n6()  
  (prompt "_.change")
  (princ "\n CHUYEN THANH DUONG CHAM CHAM ")
  (setq sset (ssget))
  (if (null sset) 
    (progn
      (princ "\nERROR: Nothing selected.")
      (exit)
    )
  )
  (command "_.change" sset "" "P" "LT" "Dot2" "") 
(princ)
)

(defun c:n2()  
  (prompt "_.change")
  (princ "\n --- ")
  (setq sset (ssget))
  (if (null sset) 
    (progn
      (princ "\nERROR: Nothing selected.")
      (exit)
    )
  )
  (command "_.change" sset "" "P" "LT" "HIDDEN" "") 
(princ)
)
(defun c:n1()  
  (prompt "_.change")
  (princ "\n CHUYEN THANH NET LIEN ")
  (setq sset (ssget))
  (if (null sset) 
    (progn
      (princ "\nERROR: Nothing selected.")
      (exit)
    )
  )
  (command "_.change" sset "" "P" "LT" "Continuous" "") 
(princ)
)
(defun c:n4()  
  (prompt "_.change")
  (princ "\n CHUYEN THANH NET TIM ")
  (setq sset (ssget))
  (if (null sset) 
    (progn
      (princ "\nERROR: Nothing selected.")
      (exit)
    )
  )
  (command "_.change" sset "" "P" "LT" "CENTER" "") 
(princ)
)
(defun c:n0()  
  (prompt "_.change")
  (princ "\n CHUYEN THANH NET BYLAYER ")
  (setq sset (ssget))
  (if (null sset) 
    (progn
      (princ "\nERROR: Nothing selected.")
      (exit)
    )
  )
  (command "_.change" sset "" "P" "LT" "BYLAYER" "") 
(princ)
)
(defun c:n3()  
  (prompt "_.change")
  (princ "\n CHUYEN THANH NET DUT ")
  (setq sset (ssget))
  (if (null sset) 
    (progn
      (princ "\nERROR: Nothing selected.")
      (exit)
    )
  )
  (command "_.change" sset "" "P" "LT" "Acad_iso03W100" "") 
(princ)
)
(defun c:n5()  
  (prompt "_.change")
  (princ "\n CHUYEN THANH NET TAM ")
  (setq sset (ssget))
  (if (null sset) 
    (progn
      (princ "\nERROR: Nothing selected.")
      (exit)
    )
  )
  (command "_.change" sset "" "P" "LT" "Dashdot" "") 
(princ)
)

*************** Lay toa do cua 1 diem ********************************** 
(defun c:ltd()
  (setq p nil tl nil bd nil nghieng nil text nil htext nil)
 (command "layer" "make" "Text" "c" "3" "" "")
 (command "style" "Vntimeshx" "vntime.shx,vn1.shx" 0.0 "0.8" 0.0 "" "" "")
(setq p (getpoint "\nDiem muon lay do do : " ))
(setq dc (getpoint "\nDiem ghi toa do: " ))
(setq bdy (list (+ (car dc) 10) (cadr dc)))
(setq bdx (list (- (car dc) 10) (cadr dc)))
(setq textx (rtos (cadr p) 2 4))  
(setq texty (rtos (car p) 2 4))  
(command "text" "j" "Mc"  bdx 2 "" texty "")
(command "text" "j" "Mc"  bdy 2 "" textx "")
)

;;; =========================== Layer hien hanh =============================
(defun layset (/ LAY) (setvar "cmdecho" 0)
 (setq LAY (entsel "\nPick vao doi tuong muon Layer hien hanh la Layer cua doi tuong do : "))
 (if LAY     (progn     
  (setq LAY (cdr (assoc 8 (entget (car LAY)))))
  (command "_.layer" "set" LAY "") (princ (strcat "\nLayer : " LAY " da la hien hanh."))  )
             (progn
      (if (not ddlop) (load "ddlop"))  (if (setq LAY (ddlop)) 
             (progn
            (command "_.LAYER" "ON" LAY "THAW" LAY "SET" LAY "")  (princ (strcat "\nLayer : " LAY " da la hien hanh.")) ) ) ) )(princ) )
(defun c:w1     () (layset))(defun c:LAYSET () (layset))
;;; ================== Cap nhat doi tuong vao layer hien hanh ==================
(Defun LAYCUR (/ SS CNT LAY)  (setvar "cmdecho" 0)
  (if (not (setq SS (ssget "i")))
    (progn (prompt "\nChon doi tuong cap nhat vao layer hien hanh: ")
      (setq SS (ssget))    )  )
  (if SS    (progn
   (setq CNT (sslength SS)) (princ (strcat "\n" (itoa CNT) " doi tuong tim thay."))                  (command "_.move" SS "")                      
      (if (> (getvar "cmdactive") 0)                
        (progn
          (command "0,0" "0,0") (setq SS  (ssget "p") CNT (- CNT (sslength SS))    )   )
          (setq SS nil)     )  (if (> CNT 0)                                 
          (princ (strcat "\n" (itoa CNT) " doi tuong tren layer LOCK.")) ) ) )
  (if SS    (progn
      (setq LAY (getvar "CLAYER")) (command "_.chprop" SS "" "_la" LAY "")
      (if (= (sslength SS) 1)
        (prompt (strcat "\n1 doi tuong da cap nhat vao layer : " LAY " (layer hien hanh)."))
        (prompt (strcat "\n" (itoa (sslength SS)) " doi tuong da cap nhat vao layer : " LAY " (layer hien hanh).")) ) ))  (princ) );end
(defun c:LAYCUR () (laycur)) (defun c:w2    () (laycur))
;;; =========================== Layer Iso ===================================
(Defun LAYISO (/ SS CNT LAY LAYLST VAL)  (setvar "cmdecho" 0)
  (if (not (setq SS (ssget "i")))    (progn
      (prompt "\nChon doi tuong tren layer(s) muon lam viec doc lap: ")
      (setq SS (ssget))    )  )
  (if SS    (progn      (setq CNT 0)
      (while (setq LAY (ssname SS CNT))
        (setq LAY (cdr (assoc 8 (entget LAY))))
        (if (not (member LAY LAYLST))
          (setq LAYLST (cons LAY LAYLST))        )
        (setq CNT (1+ CNT))      )
      (if (member (getvar "CLAYER") LAYLST)
        (setq LAY (getvar "CLAYER"))
        (setvar "CLAYER" (setq LAY (last LAYLST)))      )
      (command "_.LAYER" "_OFF" "*" "_Y")
      (foreach VAL LAYLST (command "_ON" VAL))
      (command "")            (if (= (length LAYLST) 1)
        (prompt (strcat "\nLayer " (car LAYLST) " da tach ra."))
        (prompt (strcat "\n" (itoa (length LAYLST)) " layers da tach ra. "
                        "Layer " LAY " la hien hanh."   )  )  )  )  )  (princ) )
(defun c:LAYISO () (layiso)) (defun c:w3 () (layiso))
;;; =========================  Layer Match ==================================
(Defun LAYMCH (/ SS CNT LOOP LAY ANS)
  (setvar "cmdecho" 0)
  (if (not (setq SS (ssget "i")))    (progn
      (prompt "\nChon doi tuong muon thay doi Layer : ")
      (setq SS (ssget))    )  )
  (if SS    (progn
      (setq CNT (sslength SS))
      (princ (strcat "\n" (itoa CNT) " found."))  (command "_.move" SS "")                        
      (if (> (getvar "cmdactive") 0)   (progn
          (command "0,0" "0,0")  (setq SS  (ssget "p")
                CNT (- CNT (sslength SS))    )    )
        (setq SS nil)      )  (if (> CNT 0)                                    
          (princ (strcat "\n" (itoa CNT) " tren layer LOCK.")) ) )  )
  (if SS    (progn
      (initget "Ten")  (setq LAY  (entsel "\nTen layer/<Pick doi tuong>: ")  LOOP T  )
    (while LOOP        (cond
          ((not LAY)
            (prompt "\nKhong chon doi tuong.")
            (prompt "\nSu dung layer hien hanh? <Y> ")
            (setq ANS (strcase (getstring)))
            (if (or (= ANS "") (= ANS "Y") (= ANS "YES"))
              (setq LAY  (getvar "clayer")  LOOP nil )  )  )
          ((listp LAY)  (setq LOOP nil) )
          ((= LAY "Ten")
            (setq LAY (getstring "\n>Nhap ten layer: "))
            (cond
              ((tblsearch "LAYER" LAY)  (setq LOOP nil)   )
              ((/= LAY "")
                (prompt "\nLayer chua co trong ban ve. Tao layer moi? <Y>: ")
                (setq ANS (strcase (getstring)))
                (if (or (= ANS "") (= ANS "Y") (= ANS "YES"))
		    (progn
		        (command "_.LAYER" "NEW" LAY "")
                        (setq LOOP nil)   )
                    (prompt "\nLoi ten layer.")   )   )  )  )   )
        (if LOOP  (progn (initget "Ten")
            (setq LAY  (entsel "\nTen layer/<Pick doi tuong>: ")) ) ) ); while LOOP
        (if (listp LAY)
        (setq LAY (cdr (assoc 8 (entget (car LAY)))))      )
      (command "_.chprop" SS "" "_la" LAY "")
      (if SS  (prompt (strcat "\n" (itoa (sslength SS)) " doi tuong thay doi toi layer " LAY )) )
      (if (= LAY (getvar "clayer"))
        (prompt " (layer hien hanh).")  (prompt ".") ) ) )  (princ) )
(defun c:LAYMCH () (laymch)) (defun c:CLL    () (laymch))
;;; ============================ Layer OFF =================================
(DEFUN LAYOFF (/ SSET SSL ENT LAY I MODE) (setvar "cmdecho" 0) 
  (prompt "\nChon doi tuong tren layer(s) muon OFF: ")
  (SETQ SSET (SSGET))   (IF (/= NIL SSET) (PROGN
     (SETQ SSL (SSLENGTH SSET))  (SETQ LAY "") (SETQ I 0) (SETQ MODE 0) 
     (WHILE (< I SSL)
       (SETQ ENT (ENTGET (SSNAME SSET I)))
       (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
       (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) ))  (SETQ I (+ I 1)))
     (COMMAND "LAYER" "OFF" LAY "")
     (IF (= MODE 1) (COMMAND ""))))
 (setq Loff6 Loff5) (setq Loff5 Loff4) (setq Loff4 Loff3) (setq Loff3 Loff2) (setq Loff2 Loff1) (setq Loff1 LAY)
 (princ (strcat "\n      Layer : " LAY " da OFF.")) (setvar "cmdecho" 1)   (princ))
(defun c:LAYOFF () (layoff)) (defun c:w4     () (layoff))
;;; ================================ Layer ON ==============================
(Defun LAYON ()  (setvar "cmdecho" 0)
 (setq Lay loff1) (setq Loff1 Loff2) (setq Loff2 Loff3) (setq Loff3 Loff4) (setq Loff4 Loff5) (setq Loff5 Loff6) (setq Loff6 "0")
  (Command "LAYER" "ON" Lay "") (princ (strcat "\n      Layer : " LAY " da ON."))  (princ))
(defun c:LAYON () (layon)) (defun c:LOO   () (layon))
(Defun C:w5 () (setvar "cmdecho" 0)  (Command "_.LAYER" "_ON" "*" "") (princ "\nDa ON toan bo cac Layer !") (princ))
;;; ============================== Layer Freeze ===========================
(Defun LAYFRZ (/ LAY TEMP)(setvar "cmdecho" 0) 
(prompt "\nChon doi tuong tren layer(s) muon FREEZE: ") (SETQ SSET (SSGET))
 (IF (/= NIL SSET) (PROGN
     (SETQ SSL (SSLENGTH SSET))  (SETQ LAY "") (SETQ I 0) (SETQ MODE 0) 
     (WHILE (< I SSL)
       (SETQ ENT (ENTGET (SSNAME SSET I)))
       (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
       (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) )) (SETQ I (+ I 1)))
     (COMMAND "LAYER" "FREEZE" LAY "")
     (IF (= MODE 1) (COMMAND ""))))
 (setq Lff6 Lff5) (setq Lff5 Lff4) (setq Lff4 Lff3) (setq Lff3 Lff2) (setq Lff2 Lff1) (setq Lff1 LAY)
 (princ (strcat "\n      Layer " LAY " da FREEZE."))(setvar "cmdecho" 1) (princ) )
(defun c:LAYFRZ () (layfrz)) (defun c:LF     () (layfrz))

;;============================= Change Color Layer ===========================
(DEFUN C:LAC (/ SSET SSL ENT COL LAY I MODE)
   (SETQ SSET (SSGET))
   (IF (/= NIL SSET) 
    (PROGN
     (SETQ SSL (SSLENGTH SSET))
     (SETQ LAY "")
     (SETQ I 0)
     (SETQ MODE 0) 
     (WHILE (< I SSL)
       	  (SETQ ENT (ENTGET (SSNAME SSET I)))
	  (IF (= (CDR (ASSOC '8 ENT)) (GETVAR "CLAYER")) (SETQ MODE 1) )
          (SETQ LAY (STRCAT LAY "," (CDR (ASSOC '8 ENT)) ))
          (SETQ I (+ I 1))     )
 (setq COL (getstring "\nNew color : "))
   (COMMAND "LAYER" "C" COL LAY "")
     (IF (= MODE 1) (COMMAND "") )    )   )
   (prompt (strcat "\nLayer has changed: " LAY))
   (setvar "cmdecho" 1) (princ) )
;; ================ Change layer for DIM =============================
(DEFUN C:LAD (/ SSET SSL M LAY I)
   (PRINC "\nSelect dimensions :")
   (SETQ SSET (SSGET))
   (IF (/= NIL SSET) (PROGN
   (SETQ SSL (SSLENGTH SSET))
   (SETQ LAY (GETSTRING "\nNew layer : "))
   (IF (/= LAY NIL) 
      (PROGN  		
   	(SETQ I 0)
   	(WHILE (< I SSL)
       	  (SETQ M (ENTGET (SSNAME SSET I)))
          (IF (= (CDR (ASSOC '0 M)) "DIMENSION") 
              (PROGN
               (SETQ M (SUBST (CONS 8 LAY) (ASSOC 8 M) M))  (ENTMOD M) ) ) 
          (SETQ I (+ I 1))  )  ) )))  (PRINC) )
;; ================ Change layer for TEXT =============================
(DEFUN C:LAT (/ SSET SSL M LAY I)
   (PRINC "\nSelect Text :")
   (SETQ SSET (SSGET))
   (IF (/= NIL SSET) (PROGN
   (SETQ SSL (SSLENGTH SSET))
   (SETQ LAY (GETSTRING "\nNew layer : "))
   (IF (/= LAY NIL) 
      (PROGN  		
   	(SETQ I 0)
   	(WHILE (< I SSL)
       	  (SETQ M (ENTGET (SSNAME SSET I)))
          (IF (= (CDR (ASSOC '0 M)) "TEXT") 
              (PROGN
               (SETQ M (SUBST (CONS 8 LAY) (ASSOC 8 M) M))  (ENTMOD M) ) ) 
          (SETQ I (+ I 1))  )  ) )))  (PRINC) )


;;=========================Tinh dien tich==============================
(defun c:aa()
  (if (= tl nil) (progn
    (setq tl (getreal "\nDrawing scale<1/> : "))
    (setq ntl tl)
    (setq tl2 (* ntl ntl))
    )
  )
  (setq dtl 0)
  (setq ss (ssadd))
  (setq oslast (getvar "OSMODE"))
  (command "osnap" "")
  (print)
  (print)
  (setq pt1 (getpoint "\nChon mot diem trong vung dien tich can tinh: "))
  (while (/= pt1 nil)
    (command "-boundary" pt1 "")
    (setq et (entlast))
    (ssadd et ss)
    (command "area" "e" "last")
    (setq vsize ( /(getvar "VIEWSIZE") 3 ))
    (command "hatch" "ANSI31" vsize "0" "last" "")
    (setq et (entlast))
    (ssadd et ss)
    (setq dtcon (getvar "AREA"))
    (setq dtl (+ dtcon dtl))
    (print)
    (print)
    (setq pt1 (getpoint "\nChon mot diem trong vung dien tich tiep theo : "))
  )
  (command "setvar" "OSMODE" oslast)
  (command "erase" ss "")
  (setq ss nil)
  (command "redraw" )
  (setq dtl (* dtl tl2))
  (print dtl)
  (setq elst (entget (car (entsel "Thay cho so: "))))
  (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
  (entmod elst)
  ;(print)
  (prompt (strcat "\nTong dien tich: " (rtos dtl 2 4)))
  (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun
;(setq caodo (atof (assoc 1 ((entget (car (entsel "Thay cho so: ")))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dz (/ d1 d2 d3 t1 t2)
(prompt "\n Tinh chieu dai cua nhieu doan zichzac")
  (setq t1 0)
  (setq pr1 0)
  (if (= sc nil) (setq sc (getreal "\n Nhap ty le ve: ")))
  (setq cle 0)
  (setq Xcle 0)
  (while 
  (setq d1 (getpoint "\n Chon diem bat dau:"))
    	(while 
  	(setq d2 (getpoint d1 "\n Chon diem tiep theo:"))
  	(setq t2 (distance d1 d2))
	(setq tt (* sc t2))
	(setq Xcle1 (* sc (- (car D2) (car D1))))
	(setq Xcle (+ Xcle Xcle1))
	(prompt "\n K/C le la:")
	(princ tt)
  	(setq d1 d2) 
  	(setq t2 (+ t1 t2))
	(setq t1 t2)
	(setq t2 (* t2 sc))	
  	(prompt "\n Tong cac khoang cach la:")
  	(princ t2)
	)
  )
  (setq xcle30 (* 0.15 t2))
  (prompt "\n Tong cac khoang cach la:")(princ t2)
  (prompt "\n Tong cac khoang cach nam ngang la:")(princ Xcle)
  (prompt "***L/2 (30cm):")(princ Xcle30)
  (setq cle t2)
  (setq thchon (nentselp"\nChon text can thay the:"))
  (if (/= nil thchon)
    (progn
      (setq en (car thchon))
      (COMMAND "CHANGE" en "" "" "" "" "" "" (rtos t2 2 2))
      (COMMAND "CHANGE" en "" "p" "c" "2" "")
      )
    )
  
  
  (princ)
)
;;================

;;============Tinh toa do khi biet cao do diem chon lam c:goc====================
;;Ket qua cho cao do diem chon va khoang cach den c:goc cung nhu kc den diem vua chon
;;Truc duong ben phai
(defun c:td ()
  (PROMPT "\n(Lenh tinh toa do & K/C 1 diem bat ky)")
  (c:goc)
  (setq xa (* sc (car a)))
  (setq ya (* sc (cadr a)))
  (setq l1 xa)
  (setq l3 ya)
  (While
    (setq b (Getpoint "\n Chon diem can tinh:"))
    (setq xb (* sc (car b)))
    (setq x (- xb xa))
    (setq yb (* sc (cadr b)))
    (setq y (+ g (- yb ya)))
    (setq ypr (rtos y 2 3))
    (setq l2 xb)
    (setq l4 yb)
    (setq dy (- l4 l3))
    (setq l3 l4)
    (setq l (- l2 l1))
    (setq ypr1 (rtos L 2 3))
    (setq l1 l2)
    (setq thchon (nentselp"\nChon text can thay the:"))
    (if (/= nil thchon)
      (progn
	(setq en (car thchon))
	(setq en (entget en)) 
                (setq en (subst (cons 1 (rtos y 2 2)) (assoc 1 en) en))
                (entmod en)

	)
  
)
    (Prompt "\nCao do diem vua chon:")  (princ (rtos y 2 3))
    (Prompt "\nK/C x le:")  (princ (rtos l 2 3))
    (Prompt " _ K/C x den diem goc:")  (princ (rtos x 2 3))
    (if (= 0 l)
      (Prompt " _ Do doc doan vua chon: E%")
      (Progn
	(setq dd (* 100 (/ dy l)))
	(Prompt " _ Do doc doan vua chon:")(princ (rtos dd 2 3))(princ "%")
	)
      )
    
    ;(setq pt2 (getpoint "\nDiem ghi cao do vua tinh duoc :"))
    ;(command "TEXT" pt2 "" "90" ypr)
    ;(setq pt3 (getpoint "\nDiem ghi K/C le vua tinh duoc :"))
    ;(command "TEXT" pt3 "" "90" ypr1)
    ;(setq a '(0 0 0) g 0)
    (princ)
    )
  )
;;;;

(DEFUN C:DG () (setq a (Getpoint "Chon lai diem c:goc:"))
  (setq g (Getreal "\n Nhap cao do diem c:goc:" )))

;;Truc duong ben phai
;;Lenh tinh cao do & ve duong giong cho 1 diem tren duong do
(defun c:dm ()
  (PROMPT "\n(Lenh tinh cao do & ve duong giong cho 1 diem tren duong do)")
  (setq os1 (getvar "osmode"))
  (command "_.UNDO" "_GROUP")
  (c:goc)
  (setq ya (* sc (cadr a)))
  (setq b (Getpoint "\n Chon diem can tinh:"))
  (SETVAR "OSMODE" 0)  
  (setq xt (car b))
  (setq yt (cadr b))
  (setq yb (* sc (cadr b)))
  (setq y (rtos (+ g (- yb ya)) 2 3))
  (command "text"  "j" "mc" (list xt 18.625) "" "90" y)
  (command "zoom" "e")  
  (COMMAND "CHANGE" "LAST" "" "p" "c" "4" "")
  (command "layer" "s" "dcd" "")
  (command "line" (list xt yt) (list xt 19.25) "" )
  (command "line" (list xt 16.75) (list xt 15.50) "")
  (command "layer" "s" "ddo" "")
  (command "zoom" "p")  
  (SETVAR "OSMODE" os1)
  (command "_.UNDO" "_END")
(princ)
)

;;;
(defun c:cl ()
  (if (= sc nil) (setq sc (getreal "\n Nhap ty le ve: ")))
  (prompt "chon 2 diem can ghi K/C:")
  (setq x1 (getpoint))
  (setq x2 (getpoint x1))
  (setq kc (* sc (- (car x2) (car x1))))
  (setq kcs (rtos kc 2 2))
  (if (> kc 1.3)
    (setq angl 0)
    (setq angl 90)
    )
  (setq Xtb (/ (+ (car x2) (car x1)) 2))
  (setq Ytb (+ 0.625 (cadr x1)))
  (setq tdtb (list xtb ytb))
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (command "text"  "j" "mc" tdtb "" angl kcs)
  (COMMAND "CHANGE" "LAST" "" "p" "c" "4" "")
  (setvar "osmode" osm)
  (princ)
)
;;;;;;;
(defun c:tle () 
  (setq tle (getreal "\nNhap lai ty le ve: "))
  (setq sc tle)
)
??????????????????????????????????????????????????????????????

;;;;;;;;;;;;;;
(DEFUN C:tong ()
(prompt "\n(Lenh tinh tong 1 tap hop so:)")
  (PROMPT "\nChon tap hop so can tinh tong:")
  (command "_.UNDO" "_GROUP")
  (SETQ SS  (SSGET '((0 . "TEXT"))))
  (setq n 0)
  (setq x2 0)
  (while   (< n (sslength ss))
    (setq thop (ENTGET (SSNAME SS n)))
    (if (NUMBERP (READ (CDR (ASSOC 1 thop))))
      (progn
	(SETQ X1 (ATOF (CDR (ASSOC 1 thop))))
	(SETQ X2 (+ x2 X1))
	)
      )
    (setq n (1+ n))
    )
  (PROMPT "\nTong can tinh toan la:")
  (print x2)
  (setq thchon (nentselp"\nChon text can thay the:"))
  (if (/= nil thchon)
    (progn
      (setq en (car thchon))
      (COMMAND "CHANGE" en "" "" "" "" "" "" (rtos x2 2 2))
      (COMMAND "CHANGE" en "" "p" "c" "2" "")
      )
    )
  
  
  (princ)
)
;;;;;;;;;;;;;;
(DEFUN C:nh ()
(prompt "\n(Lenh tinh tich 1 tap hop so:)")
  (PROMPT "\nChon tap hop so can tinh tich:")
  (command "_.UNDO" "_GROUP")
  (SETQ SS  (SSGET '((0 . "TEXT"))))
  (setq n 0)
  (setq x2 1)
  (while   (< n (sslength ss))
    (setq thop (ENTGET (SSNAME SS n)))
    (if (NUMBERP (READ (CDR (ASSOC 1 thop))))
      (progn
	(SETQ X1 (ATOF (CDR (ASSOC 1 thop))))
	(SETQ X2 (* x2 X1))
	)
      )
    (setq n (1+ n))
    )
  (PROMPT "\nTich can tinh toan la:")
  (print x2)
  (setq thchon (nentselp"\nChon text can thay the:"))
  (if (/= nil thchon)
    (progn
      (setq en (car thchon))
      (COMMAND "CHANGE" en "" "" "" "" "" "" (rtos x2 2 2))
      (COMMAND "CHANGE" en "" "p" "c" "2" "")
      )
    )
  
  
  (princ)
)
;;;;;;;;;;;;;;
(DEFUN C:Tru ()
(prompt "\n(Lenh tinh hieu 2 so:)")
  (command "_.UNDO" "_GROUP")
  (setq thop1 (car(nentselp"\nChon so tru:")))
  (setq thop2 (car(nentselp"\nChon bi so tru:")))
  (SETQ X1 (ATOF (CDR (ASSOC 1 (entget thop1)))))
  (SETQ X2 (ATOF (CDR (ASSOC 1 (entget thop2)))))
  (SETQ X (- X1 X2))
  (PROMPT "\nHieu can tinh toan la:")
  (print x)
  (setq thchon (nentselp"\nChon text can thay the:"))
  (command "_.UNDO" "_END")
  (if (/= nil thchon)
    (progn
      (setq en (car thchon))
      (COMMAND "CHANGE" en "" "" "" "" "" "" (rtos x 2 2))
      (COMMAND "CHANGE" en "" "p" "c" "2" "")
      )
    )
  
  
  (princ)
)
;;;;;;;;;;;;;;
(DEFUN C:chia ()
(prompt "\n(Lenh tinh thuong 2 so:)")
  (command "_.UNDO" "_GROUP")
  (setq thop1 (car(nentselp"\nChon so chia:")))
  (setq thop2 (car(nentselp"\nChon bi chia:")))
  (SETQ X1 (ATOF (CDR (ASSOC 1 (entget thop1)))))
  (SETQ X2 (ATOF (CDR (ASSOC 1 (entget thop2)))))
  (SETQ X (/ X1 X2))
  (command "_.UNDO" "_END")
  (PROMPT "\nThuong can tinh toan la:")
  (print x)
(setq thchon (nentselp"\nChon text can thay the:"))
  (command "_.UNDO" "_END")  
(if (/= nil thchon)
    (progn
      (setq en (car thchon))
      (COMMAND "CHANGE" en "" "" "" "" "" "" (rtos x 2 2))
      (COMMAND "CHANGE" en "" "p" "c" "2" "")
      )
    )
  
  
  (princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:cdo ()
  (setvar "cmdecho" 0)
  (Command ".Purge" "B" "MUITEN" "y" "y")
  (setq BLK (ssget "X" (list (cons 2 "MUITEN"))))
  (if (= BLK nil)
    (Progn
      (setq osn (getvar "osmode"))
      (setvar "osmode" 0)    
      (command ".zoom" "w" "-1,0.9" "0.5,-0.2")
      (Command "Line" "-0.2,0" "0.2,0" "" "Line" "0,0.65" "0,0" "0.1,0.18"
	       "-0.1,0.18" "0,0" "" "Line" "0.1,0.35" "-0.87,0.35" "")
      (Setq ssmuiten (ssget "W" '(-2 0.9) '(0.5 -0.2)))
      (Command "_.Block" "muiten" "0,0" ssmuiten "")
      (command ".zoom" "p")
      (setvar "osmode" osn)
      )
    )
  (c:goc)
  (setq xa (car a))
  (setq ya (cadr a))
  (While
    (setq b (Getpoint "\n Chon diem can tinh va ghi cao do:"))
    (setq xb (car b))
    (setq dx (* sc (- xb xa)))
    (setq yb (cadr b))
    (setq y (+ g (* sc (- yb ya))))
    (setq osn1 (getvar "osmode"))
    (setvar "osmode" 0)
    (setq diemghi (list (- xb (/ 0.04 sc)) (+ yb (/ 0.4 sc))))
    (Command "Insert" "muiten" b (/ 1.0 sc) (/ 1.0 sc) "0")
    (Command "text" "j" "r" diemghi 0.15 "0" (rtos y 2 3))
    (COMMAND "CHANGE" "LAST" "" "p" "c" "4" "")
    (setvar "osmode" osn1)
    )
    (princ)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tb ()
  (setvar "cmdecho" 0)
  (setq sspl (SSGET))
  (setq n 0)
  (setq l1 0)
  (while   (< n (sslength sspl))
    (setq xa (car(cdr(assoc 10 (entget (ssname sspl n))))))
    (setq ya (car(cdr(cdr(assoc 10 (entget (ssname sspl n)))))))
    (setq xb (car(cdr(assoc 11 (entget (ssname sspl n))))))
    (setq yb (car(cdr(cdr(assoc 11 (entget (ssname sspl n)))))))
    (setq l (sqrt(+ (* (- xa xb) (- xa xb)) (* (- ya yb) (- ya yb)))))
    (setq l1 (+ l1 l))
    (setq n (1+ n))
    )
  (setq xa (car(cdr(assoc 10 (entget (ssname sspl 0))))))
  (setq ya (car(cdr(cdr(assoc 10 (entget (ssname sspl 0)))))))
  (setq xb (car(cdr(assoc 11 (entget (ssname sspl 0))))))
  (setq yb (car(cdr(cdr(assoc 11 (entget (ssname sspl 0)))))))
  (setq lo (sqrt(+ (* (- xa xb) (- xa xb)) (* (- ya yb) (- ya yb)))))
  (setq ltb (/ l1 n))
  (prompt "Ltong= ")(princ l1)
  (prompt "***n= ")(princ n)
  (prompt "***Ltb= ")(princ ltb)
  (prompt "***Lmin= ")(princ lo)
  (prompt "***Lmax= ")(princ l)
  (princ)
  )
; Hide & Show 

(defun c:q (/ SSet Count Elem)
  
  (defun Dxf (Id Obj)
    (cdr (assoc Id (entget Obj)))
  );end Dxf
  
  (prompt "\nSelect object(s) to hide: ")
  (cond
    ((setq SSet (ssget))
     (repeat (setq Count (sslength SSet))
       (setq Count (1- COunt)
	     Elem (ssname SSet Count))
       (if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
	 (if (Dxf 60 Elem)
	   (entmod (subst '(60 . 1) (assoc 60 (entget Elem)) (entget Elem)))
	   (entmod (append (entget Elem) (list '(60 . 1))))
	 )
	 (prompt "\nEntity on a locked layer. Cannot hide this entity. ")
       );end if
     );end repeat
    )	 	
  );end cond
  (princ)
);end c:InVis



(defun c:qq (/ WhatNextSSet Count Elem)

  (defun Dxf (Id Obj)
    (cdr (assoc Id (entget Obj)))
  );end Dxf

 (cond
  ((setq SSet (ssget "_X" '((60 . 1))))
   (initget "Yes No")
   (setq WhatNext (cond
		   ((getkword "\nAll hidden entities will be visible. Continue? No, <Yes>: "))
		   (T "Yes")))
   (cond
   ((= WhatNext "Yes")
    (prompt "\nPlease wait...")
     (repeat (setq Count (sslength SSet))
       (setq Count (1- COunt)
	     Elem (ssname SSet Count))
       (if (/= 4 (logand 4 (Dxf 70 (tblobjname "layer" (Dxf 8 Elem)))))
	 (entmod (subst '(60 . 0) '(60 . 1) (entget Elem)))
	 (prompt "\nEntity on a locked layer. Cannot make visible this entity. ")
       );end if
     );end repeat
    (prompt "\nDone...")
    )
   );end cond
  )
  (T (prompt "\nNo objects was hidden. "))
 )
)
;==============================================

Do trình độ gà nên em ko chỉnh đc nên các bác chỉnh hộ em 2 vấn đề với ạ

thứ 1: khi em dùng thì hay mất phần bắt điểm

thứ 2: các bác thêm giúp em phần khi chọn text cần thay số thì text đó tự đông chuyển sang màu đỏ với ạ

em cám ơn

em dùng lệnh aa enter 1 enter rồi chọn vùng cần tính diện tích.chọn text cần thay ..


<<

Filename: 289763_hm_trogiup_1_2_3_4_5_6_7_8_9_10_11_12_20_30_32_35_13_q1_q2_q3_q4_q5_ng_e1_e2_25_dm_dmt_dmn_kh_c0_c1_c2_c3_c4_c5_c6_c7_c8_c9_c10_c11_c12_c13_cdm_cdmt_cdmn_ckh_cq1_cq2_cq3_cq4_cq5_cng_ce1_ce2_c20_c30_c32_c35_t1_t2_t3_t4_t5_t6_t7_t8_t9_t10_t11_t1
Tác giả: 790312
Bài viết gốc: 400246
Tên lệnh: tt%C2%A0
Nhờ Chỉnh Lisp Cắt Thép Dầm Momen

 

Vội nên chưa test, có gì bạn phản hồi nhé!

(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len...
>>

 

Vội nên chưa test, có gì bạn phản hồi nhé!

(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3 po4 pt1 pt2 pt3 pt4 tlv p11 p33)
 (defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       cdi (* (getvar "DIMTXT") (getvar "DIMSCALE")))
 (if (and (setq pt1 (getpoint "\nDiem p1: "))
          (setq pt2 (getpoint "\nDiem p2: "))
          (setq pt3 (getpoint "\nDiem p3: "))
          (setq pt4 (getpoint "\nDiem p4: "))
          (setq hcd (getdist "\nChieu cao dam: "))
          (setq hbv (getdist "\nChieu day bt bao ve: "))
          (setq tlv (getreal "\nTi le ve <Nhap 20 de co ty le 1/20>:")))
  (progn (setq po1 (polar (polar pt3 (* pi 1.0) (* hcd (/ 100 tlv))) (* pi 0.5) (* hbv (/ 100 tlv)))
               po2 (polar po1 (* pi (/ 30 180.0)) 70)
               po3 (polar (polar pt4 (* pi 0.0) (* hcd (/ 100 tlv))) (* pi 0.5) (* hbv (/ 100 tlv)))
               po4 (polar po3 (* pi (/ 150 180.0)) 70)
               ang (angle pt1 pt2)
               pd3 (polar pt1 (+ ang (* pi 1.5)) (* cdi 4)))
         (Make-Line po1 po2 "CAT-THEP")
         (Make-Line po3 po4 "CAT-THEP")
         (setq p11 (inters pt1 pt2 po1 (polar po1 (* pi 1.5) hcd))
               p33 (inters pt1 pt2 po3 (polar po3 (* pi 1.5) hcd)))
         (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
                 (mapcar 'vlax-3d-point (list pt1 pt2 p11))
                 (mapcar 'vlax-3d-point (list p11 p33 p33))
                 (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))))
 (princ))

Nhờ bác thêm vào lisp để nó vẽ đường thẳng từ móc này đến móc kia giùm e với, nó sẽ thành một thanh polyline.

Cảm ơn bác nhiều.


<<

Filename: 400246_tt%C2%A0.lsp
Tác giả: 790312
Bài viết gốc: 400268
Tên lệnh: tt
Nhờ Chỉnh Lisp Cắt Thép Dầm Momen
(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3 po4 pt1 pt2 pt3 pt4 tlv p11 p33)
;;;ve pline 
(defun...
>>
(defun c:tt  (/ Make-Line ang bv cdi hbv hcd len msp pd3 po1 po2 po3 po4 pt1 pt2 pt3 pt4 tlv p11 p33)
;;;ve pline 
(defun Make_pline  (listpoint Layer / Lst)
  (setq lst (list '(0 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 8 layer)
                  (cons 90 (length listpoint))
                  (cons 70 0)))
  (foreach p listpoint (setq lst (append lst (list (cons 10 p)))))
  (entmakex lst))
;;;;ham ve pline 
(defun Make-Line  (p1 p2 lay)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 lay))))
 (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
       cdi (* (getvar "DIMTXT") (getvar "DIMSCALE")))
 (if (and (setq pt1 (getpoint "\nDiem p1: "))
          (setq pt2 (getpoint "\nDiem p2: "))
          (setq pt3 (getpoint "\nDiem p3: "))
          (setq pt4 (getpoint "\nDiem p4: "))
          (setq hcd (getdist "\nChieu cao dam: "))
          (setq hbv (getdist "\nChieu day bt bao ve: "))
          (setq tlv (getreal "\nTi le ve <Nhap 20 de co ty le 1/20>:")))
  (progn (setq po1 (polar (polar pt3 (* pi 1.0) (* hcd (/ 100 tlv))) (* pi 0.5) (* hbv (/ 100 tlv)))
               po2 (polar po1 (* pi (/ 30 180.0)) 70)
               po3 (polar (polar pt4 (* pi 0.0) (* hcd (/ 100 tlv))) (* pi 0.5) (* hbv (/ 100 tlv)))
               po4 (polar po3 (* pi (/ 150 180.0)) 70)
               ang (angle pt1 pt2)
               pd3 (polar pt1 (+ ang (* pi 1.5)) (* cdi 4)))
       (Make_pline (list po2 po1 po3 po4) "CAT-THEP")
        ; (Make-Line po1 po2 "CAT-THEP")
        ; (Make-Line po3 po4 "CAT-THEP")

         (setq p11 (inters pt1 pt2 po1 (polar po1 (* pi 1.5) hcd))
               p33 (inters pt1 pt2 po3 (polar po3 (* pi 1.5) hcd)))
         (mapcar (function (lambda (x y z) (vla-adddimaligned msp x y z)))
                 (mapcar 'vlax-3d-point (list pt1 pt2 p11))
                 (mapcar 'vlax-3d-point (list p11 p33 p33))
                 (mapcar 'vlax-3d-point (list pd3 pd3 pd3)))))
 (princ))

Hỗ trợ bác quốc mạnh để bác tập trung giúp em lisp số 3. Bạn thử xem dc chưa

 

Bác có thể chỉnh giúp khi yêu cầu nhập lớp bảo vê giá trị mặc định là 0 để vẽ móc ngay lớp thép thứ 1. Khi cần vẽ lớp 2 thì mới nhập giá trị cần. Cảm ơn bác.


<<

Filename: 400268_tt.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 431137
Tên lệnh: helix3d
Nhờ các cao thủ chỉnh sửa file lisp giúp mình!
11 giờ trước, nhunhapro123 đã nói:

#quocmanh04tt có thể giúp...

>>
11 giờ trước, nhunhapro123 đã nói:

#quocmanh04tt có thể giúp mình kiểm tra file lisp này được không ạ?

Chạy đến bước này thì báo lỗi:

Command: HELIX3D
Nhap chieu cao = 500
Number of pitches <2> = 3
Radius    = 50
Divisions points <100> = 50
Start point (Center line) ; error: bad argument type: numberp: nil

(defun C:HELIX3D  (/ ANG ANG1 ANG2 ANG3 BLIP CMD DISTX DISTY DISTY2 DISTZ PITCH PITCH2 PREC PT0 PTX RAD RADI SS TOUR X0 Y0 Z0)
 (setq CMD  (getvar "CMDECHO")
       RADI (lambda (a) (/ (* a 180) pi)))
 (setvar "CMDECHO" 0)
 (setq BLIP (getvar "BLIPMODE"))
 (setvar "BLIPMODE" 0)
 ;;Data
 (setq PITCH (getdist "\nNhap chieu cao <150> = "))
 (cond ((null PITCH) (setq PITCH 150)))
 (setq PITCH2 (getint "\nNumber of pitches <2> = "))
 (cond ((null PITCH2) (setq PITCH2 2)))
 (setq RAD (getdist "\nRadius <50> = "))
 (cond ((null RAD) (setq RAD 50)))
 (setq PREC (getint "\nDivisions points <100> = "))
 (cond ((null PREC) (setq PREC 100))) ;
 ;;Execution
 (setq TOUR 0)
 (setq ANG1 (* 0.5 pi)) ;start angle
 (setq PT0 (getpoint "Start point (Center line) "))
 (setq X0 (car PT0)
       Y0 (cadr PT0)
       Z0 (caddr PT0)) ;* add
 (setq ANG2 (/ (* 2.0 pi) PREC))
 (setq DISTY (/ PITCH PREC))
 (command ".3dpoly" (list X0 Y0 (+ Z0 RAD))) ;* mod
 (repeat PITCH2
  (repeat PREC
   (setq TOUR (+ 1 TOUR))
   (setq ANG3 (+ (* ANG2 TOUR) ANG1))
   (setq DISTY2 (* DISTY TOUR))
   (setq DISTX (* (cos ANG3) RAD))
   (setq DISTZ (* (sin ANG3) RAD)) ;* mod
   (setq PTX (list (+ DISTX X0) (+ DISTY2 Y0) (+ DISTZ Z0))) ;* mod
   (command PTX)))
 (command "")
 ;;Rotation
 (setq ANG (getangle PT0 "\nRotation angle <90>    "))
 (cond ((null ANG) (setq ANG (/ pi 2.0))))
 (setq ANG (RADI ANG))
 (setq ANG (- ANG 90.0))
 (setq ss (ssget "L"))
 (command ".ROTATE" ss "" PT0 ANG)
 (setvar "CMDECHO" CMD)
 (setvar "BLIPMODE" BLIP)
 (princ))

 


<<

Filename: 431137_helix3d.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 431268
Tên lệnh: x3df
Phá khối 3DF thành Polyline
6 phút trước, thanhmicco đã nói:

AH, MÌNH QUÊN ĐỂ TILE đó, bạn...

>>
6 phút trước, thanhmicco đã nói:

AH, MÌNH QUÊN ĐỂ TILE đó, bạn có lisp cho minh xin với

 

(defun c:x3df ()
 (defun ex3fone (ent)
   (setq
     p1 (dxf ent 10)
     p2 (dxf ent 11)
     p3 (dxf ent 12)
     p4 (dxf ent 13)
   )
   (ml p1 p2)
   (ml p2 p3)
   (ml p3 p4)
   (ml p4 p1)
 )
 (sudung ex3fone (setq ss (ssget '((0 . "3DFACE")))))
 (initget "Yes No")
 (if (/= (getkword "\nErase 3DFace(s)? (<Yes>/No): ") "No")
   (command ".erase" ss "")
 )
 (princ)
)
(defun dxf (ent c)
 (cdr (assoc c (entget ent)))
)
(defun ml (p1 p2)
 (entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)
(defun sudung (ham ss / sodt index entdt soapp)
 (setq	sodt  (if ss
	(sslength ss)
	0
      )
soapp 0
index 0
 )
 (repeat sodt
   (setq entdt	(ssname ss index)
  index	(1+ index)
   )
   (if	(ham entdt)
     (setq soapp (1+ soapp))
   )
 )
 soapp
)

Đây nhé bạn


<<

Filename: 431268_x3df.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 237986
Tên lệnh: edd
Nhờ các anh chị trong forums viết hộ em lisp sau.

 

Cái này em thấy đơn giản mà bác. Code của bác đây, em chỉnh lại:

 

(defun c:edd ( /...
>>

 

Cái này em thấy đơn giản mà bác. Code của bác đây, em chỉnh lại:

 

(defun c:edd ( / ssd els)
(vl-load-com)
(command "undo" "be")
(setq ssd (acet-ss-to-list (ssget (list (cons 0 "dimension")))))
(foreach dm ssd
     (if (/= (cdr (assoc 1 (entget dm))) "")
            (command "._DIMOVERRIDE" "DIMCLRT" "2" "DIMCLRD" "2" "DIMCLRE" "2" "" dm "")
     )
     (entmod els)
)
(command "undo" "e")
(princ)
)

Hề hề hề,

Thanks bác Tue_NV. Quả thực là mình không nghĩ tới việc sử dụng các biến hệ thống này. Đây là một bài học tốt cho những người đang tập vỉết lisp.


<<

Filename: 237986_edd.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 431244
Tên lệnh: tt
Chỉnh sửa mã Lisp

Bạn thử dùng lisp này xem sao! (không dùng command)

(defun c:tt  (/ b h h1 msp o1 o2 o3 p1 p2 p3 p4 p5 p6 p7 p8 p9 r w w1 _lw _rg)
  (setq msp (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
        _lw (lambda (lp lb)
              (entmakex
                (apply 'append
                       (cons (mapcar 'cons
                                     '(0 100 100 70 90)
         ...
>>

Bạn thử dùng lisp này xem sao! (không dùng command)

(defun c:tt  (/ b h h1 msp o1 o2 o3 p1 p2 p3 p4 p5 p6 p7 p8 p9 r w w1 _lw _rg)
  (setq msp (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
        _lw (lambda (lp lb)
              (entmakex
                (apply 'append
                       (cons (mapcar 'cons
                                     '(0 100 100 70 90)
                                     (list "LWPOLYLINE" "AcDbEntity" "AcDbPolyline" 1 (length lp)))
                             (cond (lb (mapcar '(lambda (a b) (list (cons 10 a) (cons 42 b))) lp lb))
                                   ((mapcar '(lambda (a) (list (cons 10 a))) lp)))))))
        _rg (lambda (o / a r)
              (setq a (vlax-make-safearray vlax-vbObject '(0 . 0)))
              (vlax-safearray-put-element a 0 o)
              (setq r (vla-AddRegion msp a))
              (vla-erase o)
              r))
  (setq B  8000 ;(getreal "\nNhap chieu dai B = ")
        W  7000 ;(getreal "\nNhap chieu rong W = ")
        H  2000 ;(getreal "\nNhap chieu cao tru H = ")
        R  1500 ;(getreal "\nNhap ban kinh tru R1= ")
        W1 3600 ;(getreal "\nNhap chieu rong W1= "))
        )
  (setq H1 2500 ;(getreal "\nNhap chieu cao dot duoi than tru H1= ")
        p1 (getpoint "\nDiem chuan: ")
;;;;Tinh toa do;;;
        p2 (polar p1 0.0 B)
        P3 (polar p2 (/ pi 2) W)
        P4 (polar p1 (/ pi 2) W)
        p5 (list (+ (car p1) (/ B 2)) (+ (cadr p1) (/ W 2)))
;;;;Tinh toa do;;;
        p6 (list (- (car p5) (/ W1 2)) (- (cadr p5) (/ R 2))) ;(+ (caddr p5) 0))
        p7 (polar p6 0.0 W1)
        p8 (polar p7 (/ pi 2) R)
        p9 (polar p6 (/ pi 2) R))
;;; Action
  (mapcar 'set
          '(o1 o2 o3)
          (mapcar '(lambda (lp lb) (vlax-ename->vla-object (_lw lp lb)))
                  (list (list p1 p2 p3 p4 p1)
                        (mapcar '(lambda (p a) (polar p (* a pi) 100))
                                (list p1 p2 p3 p4 p1)
                                '(1.25 1.75 0.25 0.75 1.25))
                        (list p6 p7 p8 p9 p6))
                  (list nil nil '(0 1 0 1 0))))
  (vla-put-elevation o3 H1)
  (mapcar '(lambda (r h / v)
             (setq v (vlax-variant-value r))
             (vla-AddExtrudedSolid msp (vlax-safearray-get-element v 0) h 0)
             (vla-erase (car (vlax-safearray->list v))))
          (mapcar '_rg (list o1 o2 o3))
          (list H1 -100 H))
  (princ))

 


<<

Filename: 431244_tt.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 431231
Tên lệnh: tm
em nhờ các anh viết list vẽ thép sàn móc như ảnh này giusp em với
Vào lúc 8/11/2018 tại 16:22, võ công thành đã nói:

>>
Vào lúc 8/11/2018 tại 16:22, võ công thành đã nói:

image.thumb.png.226e23724d1838cbd0eb946868098665.png

(defun c:tm()
 (setq oldos (getvar "osmode"))
  (setq
    p1 (getpoint "Pick diem thu nhat")
    p2 (getpoint p1 "Pick diem thu 2")
    d (getreal "Nhap duong kinh uon thep D=")
    r (/ d 2)
    dth (getreal "Chieu dai moc:")
    ang (angle p1 p2)
    )

      (setvar "osmode" 0)
      (setq

	pp2 (polar p1 (+ ang ( * 0.5 pi)) r )
	pp3 (polar p1 (+ ang pi) r)
	pp4 (polar p1 (+ ang (* 1.5 pi)) r )
	pp5 (polar pp2 ang dth)

	pp6 (polar p2 (+ ang ( * 0.5 pi)) r )
	pp7 (polar p2  ang  r)
	pp8 (polar p2 (+ ang (* 1.5 pi)) r )
	pp9 (polar pp6 (+ ang pi) dth)
	)
      (command "line" pp5 pp2 ""
	       "line" pp4 pp8 ""
	       "Line" pp9 pp6 ""
	       "arc" pp2 pp3 pp4
	       "arc" pp6 pp7 pp8
	)
  (setvar "osmode" oldos)
      )

Bạn xem qua


<<

Filename: 431231_tm.lsp

Trang 280/330

280