Đến nội dung


Hình ảnh
- - - - -

Ai sửa cho em cái lisp tính diện tích trong cad 2007 với


  • Please log in to reply
4 replies to this topic

#1 0907398688

0907398688

    biết zoom

  • Members
  • Pip
  • 13 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 22 April 2014 - 11:32 AM

em có cái lisp tinh diện tích.khi chọn các vùng cần tính diện tích ấn enter rồi chọn text để thay số.

bác nào cao thủ sửa thêm cho em phần khi chọn text để thay số thì text đó tự động chuyển màu 2.

bt thì em dùng lisp đó thì phải dùng thêm cái lisp chuyển màu layer hơi mất nhiều thao tác.

Nhờ các bác sửa dùng em ạ.. em xin cám ơn


  • 0

#2 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 22 April 2014 - 11:40 AM

Thấy câu hỏi thì ngon ăn nhưng hiểm cái là ko có lisp mẫu để sửa :D :D :D


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#3 0907398688

0907398688

    biết zoom

  • Members
  • Pip
  • 13 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 23 April 2014 - 09:47 AM

********************************************************************
(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?[Co/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 [Bang ban phim/Chon tren man hinh]:<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 [Bang ban phim/Chon tren man hinh]:<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 ..


  • 0

#4 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 23 April 2014 - 11:35 AM

1. "Tay nghề" khủng bố của bạn thật cao - thay vì chỉ post lên phần lisp cần sửa, bạn đưa lên nguyên 1 xe tải :D :D :D

2. Bạn thêm dòng:

(if (assoc 62 elst) (setq elst (subst (cons 62 2) (assoc 62 elst) elst)) (setq elst (cons (cons 62 2) elst)))

ngay dưới dòng:

(setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))

trong thủ tục (lệnh) aa của bạn để đổi màu text sang màu 2 nhé !


  • 2

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#5 0907398688

0907398688

    biết zoom

  • Members
  • Pip
  • 13 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 23 April 2014 - 08:23 PM

em bảo do em gà mà.bác thông cảm,thank bác nhiều.bác chỉnh lại hộ cái đó chuyển sang mày đỏ.em quên mất trong cad màu 2 là màu vàng.tại nghiện đế chế nên quan niệm mầu 2 là màu đỏ...sorry bác.có gì giúp em cho trót nhé...bác có thể thêm cho em phần khi dùng xong lẹnh aa mà em bị mất cái bắt điểm ko ạ.

;;=========================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))
(if (assoc 62 elst) (setq elst (subst (cons 62 1) (assoc 62 elst) elst)) (setq elst (cons (cons 62 1) 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: ")))))))

  • 0