Jump to content
InfoFile
Tác giả: luhaivinh
Bài viết gốc: 314822
Tên lệnh: tly taoly ddd lll hhh ttt
Bài tập chương 4

he.thanks mọi người đã gốp ý.

Không biết có còn gì chưa được nữa không. :)

Câu 4  đã được sửa.



(defun start()
  (setq oldcm (getvar "cmdecho"))
  (setq oldos (getvar "osmode"))
  (setq oldab (getvar "angbase"))
  (setq oldad (getvar "angdir")))
(defun end()
  (setvar "cmdecho" oldcm)
  (setvar "osmode" oldos)
  (setvar "angbase" oldab)
  (setvar "angdir" oldad))
(defun moment()
  (setvar "cmdecho" 0)
 ...
>>

he.thanks mọi người đã gốp ý.

Không biết có còn gì chưa được nữa không. :)

Câu 4  đã được sửa.



(defun start()
  (setq oldcm (getvar "cmdecho"))
  (setq oldos (getvar "osmode"))
  (setq oldab (getvar "angbase"))
  (setq oldad (getvar "angdir")))
(defun end()
  (setvar "cmdecho" oldcm)
  (setvar "osmode" oldos)
  (setvar "angbase" oldab)
  (setvar "angdir" oldad))
(defun moment()
  (setvar "cmdecho" 0)
  (setvar "osmode" 681)
  (setvar "angbase" 0)
  (setvar "angdir" 0))

;cau 4
(defun c:tly()
  (command "-layer" "m" "ten" "c" mau "l" "ten duong" "lw" do day net "" ""))
(defun c:taoly()
  (command "-layer" "m" "dim" "c" 2 "" "l" "continuous" "" "lw" 0.1 "" "")
  (command "-layer" "m" "hatch" "c" 1 "" "l" "continuous" "" "lw" 0.15 "" "")
  (command "-layer" "m" "text" "c" 4 "" "l" "continuous" "" "lw" 0.2 "" ""))

(defun c:ddd(/ pt1 pt2)
  (start)
  (setq ocl (getvar "clayer"))
  (moment)
  (setvar "clayer" "dim")
  (setq pt1 (getpoint "\nChon diem dau:"))
  (setq pt2 (getpoint pt1 "\nChon diem cuoi:"))
  (command "DIMALIGNED" pt1 pt2)
  (end)
  (setvar "clayer" ocl))
(defun c:lll(/ pt1 pt2 pt3)
  (start)
  (setq ocl (getvar "clayer"))
  (moment)
  (command "-layer" "m" "leader" "c" 3 "" "l" "continuous" "" "lw" 0.15 "" "")
  (setq pt1 (getpoint "\nChon diem dau:"))
  (setq pt2 (getpoint pt1 "\nChon diem thu hai:"))
  (setq pt3 (getpoint pt2 "\nChon diem cuoi:"))
  (command "leader" pt1 pt2 pt3 "" "" "")
  (end)
  (setvar "clayer" ocl))
(defun c:hhh()
  (start)
  (setq ocl (getvar "clayer"))
  (moment)
  (setvar "clayer" "hatch")
  (setq pt (getpoint "\nchon vung hatch:"))
  (command "-hatch" pt "")
  (end)
  (setvar "clayer" ocl))
(defun c:ttt(/ pt a b)
  (start)
  (setq ocl (getvar "clayer"))
  (moment)
  (setvar "clayer" "text")
  (setq pt (getpoint "\nChon diem dat chu"))
  (setq a (getreal "\nNhap chieu cao chu:"))
  (setq b (getreal "\nNhap goc xoay chu:"))
  (command "-text" pt a b)
  (end)
  (setvar "clayer" ocl))
  
  

<<

Filename: 314822_tly_taoly_ddd_lll_hhh_ttt.lsp
Tác giả: nhoclangbat
Bài viết gốc: 314932
Tên lệnh: dcapr dcapc
Nhờ Giúp Lisp Đánh Cấp

- ko biết nói sao nữa haizzz "file kiểu gì" ^^

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/14448-nho-giup-lisp-danh-cap/

(defun c:dcapr (/ cur B sp ep Lx n po1 po2 po3 i oldos ans ss )
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq cur (car (entsel "\n Ban Pick chon Pline :")) 
         ss (ssadd))
(while (null cur) 
       (setq...
>>

- ko biết nói sao nữa haizzz "file kiểu gì" ^^

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/14448-nho-giup-lisp-danh-cap/

(defun c:dcapr (/ cur B sp ep Lx n po1 po2 po3 i oldos ans ss )
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq cur (car (entsel "\n Ban Pick chon Pline :")) 
         ss (ssadd))
(while (null cur) 
       (setq cur (car (entsel "\n Ban Pick chon lai Pline :")))
)
(setq B (getdist "\n Nhap be rong danh cap :"))
(initget "T D")	
(setq ans (getkword "\n Ban danh cap Tren hay Duoi duong pline < T / D > :"))
(setq sp (vlax-curve-getClosestPointTo cur (getpoint "\n Chon diem bat dau danh cap")))			
(setq ep (vlax-curve-getClosestPointTo cur (getpoint "\n Chon diem ket thuc danh cap")))	
;;(if (> (car sp) (car ep))
;;(progn			
;;(setq ep (vlax-curve-getClosestPointTo cur (getpoint "\n Chon diem bat dau danh cap")))			
;;(setq sp (vlax-curve-getClosestPointTo cur (getpoint "\n Chon diem ket thuc danh cap")))		
;;)
;;)
(setq Lx (abs (- (car ep) (car sp)) ))
(setq n (abs(fix (/ (- Lx (rem Lx b )) b ))) i 1)
(setq po1 sp)
(Repeat n
    (if (> (car po1) (car ep))
        (setq dvi (list (- (car sp) (* i b)) (cadr sp) 0))
        (setq dvi (list (+ (car sp) (* i b )) (cadr sp) 0))
    )
    (command "Xline" "Ver" dvi "")
    (setq po3 (car (giaodt cur (entlast))) )
    (entdel (entlast))
    (if  (= ans "D") 
         (if (> (cadr po3) (cadr po1))
             (setq po2 (list (car po3) (cadr po1) 0))
             (setq po2 (list (car po1) (cadr po3) 0))
         )
         (if (< (cadr po3) (cadr po1))
              (setq po2 (list (car po3) (cadr po1) 0))
              (setq po2 (list (car po1) (cadr po3) 0))
         )
    )
    (setq ss (ssadd (dline po1 po2) ss))
    (setq ss (ssadd (dline po2 po3) ss))
    (setq po1 po3)
    (setq i (1+ i))
)
(if (= ans "D" )
     (if (> (cadr ep) (cadr po1))
          (setq po2 (list (car ep) (cadr po1) 0))
          (setq po2 (list (car po1) (cadr ep) 0))
     )
     (if (< (cadr ep) (cadr po1))
          (setq po2 (list (car ep) (cadr po1) 0))
          (setq po2 (list (car po1) (cadr ep) 0))
     )
)
(setq ss (ssadd (dline po1 po2) ss))
(setq ss (ssadd (dline po2 ep)  ss))
(command "pedit" "m" ss "" "Y" "j" "0" "")
(setvar "osmode" oldos)
(command "undo" "end")
(princ)
);
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:dcapc (/ cur B sp ep Lx n po1 po2 po3 i oldos ans ss )
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq cur (car (entsel "\n Ban Pick chon Pline :")) 
         ss (ssadd))
(while (null cur) 
       (setq cur (car (entsel "\n Ban Pick chon lai Pline :")))
)
(setq B (getdist "\n Nhap chieu cao danh cap :"))
(initget "T D")	
(setq ans (getkword "\n Ban danh cap Tren hay Duoi duong pline < T / D > :"))
(setq sp (vlax-curve-getClosestPointTo cur (getpoint "\n Chon diem bat dau danh cap")))			
(setq ep (vlax-curve-getClosestPointTo cur (getpoint "\n Chon diem ket thuc danh cap")))
;;(if (> (cadr sp) (cadr ep))
;;(progn			
;;(setq ep (vlax-curve-getStartPoint cur))			
;;(setq sp (vlax-curve-getEndPoint cur))		
;;)
;;)
(setq Lx (abs (- (cadr ep) (cadr sp)) ))
(setq n (abs(fix (/ (- Lx (rem Lx b )) b ))) i 1)
(setq po1 sp)
(Repeat n
    (if (> (cadr po1) (cadr ep))
        (setq dvi (list  (car sp) (-  (cadr sp) (* i b )) 0))
        (setq dvi (list  (car sp) (+ (* i b ) (cadr sp)) 0))
    )
    (command "Xline" "Hor" dvi "")
    (setq po3 (car (giaodt cur (entlast))) )
    (entdel (entlast))
    (if  (= ans "D") 
         (if (> (cadr po3) (cadr po1))
             (setq po2 (list (car po3) (cadr po1) 0))
             (setq po2 (list (car po1) (cadr po3) 0))
         )
         (if (< (cadr po3) (cadr po1))
              (setq po2 (list (car po3) (cadr po1) 0))
              (setq po2 (list (car po1) (cadr po3) 0))
         )
    )
    (setq ss (ssadd (dline po1 po2) ss))
    (setq ss (ssadd (dline po2 po3) ss))
    (setq po1 po3)
    (setq i (1+ i))
)
(if (= ans "D" )
     (if (> (cadr ep) (cadr po1))
          (setq po2 (list (car ep) (cadr po1) 0))
          (setq po2 (list (car po1) (cadr ep) 0))
     )
     (if (< (cadr ep) (cadr po1))
          (setq po2 (list (car ep) (cadr po1) 0))
          (setq po2 (list (car po1) (cadr ep) 0))
     )
)
(setq ss (ssadd (dline po1 po2) ss))
(setq ss (ssadd (dline po2 ep)  ss))
(command "pedit" "m" ss "" "Y" "j" "0" "")
(setvar "osmode" oldos)
(command "undo" "end")
(princ)
);
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dline(p1 p2)
(entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))));
(defun GiaoDT (ent1 ent2)
(setq ob1 (vlax-ename->vla-object ent1)
         ob2 (vlax-ename->vla-object ent2))
(setq g (vlax-variant-value(vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil))
(if g
(progn
(setq kq nil
          sd (fix (/ (length g) 3)))
(repeat sd
      (setq kq (append kq (list (list (car g) (cadr g) (caddr g)))) 
                g (cdddr g))
)
kq
)
nil
)
)
;;;

<<

Filename: 314932_dcapr_dcapc.lsp
Tác giả: nhoclangbat
Bài viết gốc: 307861
Tên lệnh: htt vuong chiaht
Chữa BT Chương 4.2 : Xử lý chuỗi

-Anh Ket cho nhoc nộp bài, cho phép nhoc bỏ wa bài 4.2.1 vs 4.2.4 hen ^^, 4.2.1 nhoc hỉu rùi, 4.2.4 nhoc đọc wa mí bài của bạn tính toán nhìu wá nhoc suy ko nỗi @@ :), mí phần set biến hệ thống nhoc next lun nha, nhoc hỉu công dụng của nó rùi khi nào sử dụng thực tế nhoc sẽ thêm vào cho lisp trơn tru, cái nhoc thấy khó là phần thực hiện lệnh vẽ nên nhoc tập trung mày mò phần này, anh Ket xem wa giúp...

>>

-Anh Ket cho nhoc nộp bài, cho phép nhoc bỏ wa bài 4.2.1 vs 4.2.4 hen ^^, 4.2.1 nhoc hỉu rùi, 4.2.4 nhoc đọc wa mí bài của bạn tính toán nhìu wá nhoc suy ko nỗi @@ :), mí phần set biến hệ thống nhoc next lun nha, nhoc hỉu công dụng của nó rùi khi nào sử dụng thực tế nhoc sẽ thêm vào cho lisp trơn tru, cái nhoc thấy khó là phần thực hiện lệnh vẽ nên nhoc tập trung mày mò phần này, anh Ket xem wa giúp nhoc

;;;ve hinh tron
(defun c:htt (/ tam sht r)
(setq tam (getpoint "\nchon tam:")
	  sht (getreal "\nnhap dien tich:")
	  r (sqrt (/ sht pi)))
(command "circle" tam r )
(command ".text" "j" "mc" tam 2.0 0 "xong")
(princ "\n")
(princ (strcat "chu vi hinh tron la: " (rtos (* 2 r pi) 2 2)))
(princ)
)
;ve hinh chu nhat
(defun C:vuong (/ pt d r)
(setq d (rtos (getreal "\n nhap do dai:") 2)
	r (rtos (getreal "\n nhap do rong:") 2)
	pt (getpoint "\nchon diem ve:"))
(command "rectang" pt (strcat "@" d "," r))
)
;chia hinh tron
(defun c:chiaht (/ pt1 r a goc line echo)
(setq echo (getvar "cmdecho"))
(setvar 'cmdecho 0)
(setq pt1 (getpoint "\n chon tam:")
	  r (getreal "\n nhap ban kinh:")
	  a (itoa (getint "\n nhap so phan mun chia:"))
	  goc (itoa (getint "\n nhap goc ban dau:")))
(command "circle" pt1 r)
(command "line" pt1 (strcat "@" (rtos r 2) "<" goc) "")
(setq line (entlast))
(command "-array" line "" "polar" pt1 a "" "y")
(setvar 'cmdecho echo)
)
 
	 
	  

<<

Filename: 307861_htt_vuong_chiaht.lsp
Tác giả: luhaivinh
Bài viết gốc: 315223
Tên lệnh: getvars vht ht vhcn tgian watch tronar
Chữa BT Chương 4.2 : Xử lý chuỗi

hehe.làm gần xong chương 4.2, nhờ mọi người xem giúp có gì chưa ổn không.

Mọi người chém mạnh tay giùm tí. :)

Nhờ mọi hướng dẫn giùm câu 4.6 tí, Mình chưa hiểu đề

 

;chuong 4-2
(defun start()
  (setq oldcm (getvar "cmdecho"))
  (setq oldcl (getvar "clayer"))
  (setq oldos (getvar "osmode"))
  (setq oldab (getvar "angbase"))
  (setq oldad (getvar "angdir")))
(defun end()
  (setvar...
>>

hehe.làm gần xong chương 4.2, nhờ mọi người xem giúp có gì chưa ổn không.

Mọi người chém mạnh tay giùm tí. :)

Nhờ mọi hướng dẫn giùm câu 4.6 tí, Mình chưa hiểu đề

 

;chuong 4-2
(defun start()
  (setq oldcm (getvar "cmdecho"))
  (setq oldcl (getvar "clayer"))
  (setq oldos (getvar "osmode"))
  (setq oldab (getvar "angbase"))
  (setq oldad (getvar "angdir")))
(defun end()
  (setvar "cmdecho" oldcm)
  (setvar "clayer" oldcl)
  (setvar "osmode" oldos)
  (setvar "angbase" oldab)
  (setvar "angdir" oldad))
(defun moment()
  (setvar "cmdecho" 0)
  (setvar "osmode" 9)
  (setvar "angbase" 0)
  (setvar "angdir" 0))

;cau 1
(defun c:getvars()
  (print (strcat "Gia tri bien cmdecho la:" (itoa (getvar "cmdecho"))))
  (print (strcat "Gia tri bien osmode la:" (itoa (getvar "osmode"))))
  (print (strcat "Gia tri bien lunits la:" (itoa (getvar "lunits"))))
  (print (strcat "Gia tri bien luprec la:" (itoa (getvar "luprec"))))
  (print (strcat "Gia tri bien aunits la:"(itoa (getvar "aunits"))))
  (print (strcat "Gia tri bien auprec la:" (itoa (getvar "auprec"))))
  (print))
;cau 2
(defun c:vht(/ pt s) ;cach 1
  (start)
  (moment)
  (setq pt (getpoint "\nChon tam duong tron:"))
  (setq s (getreal "\nNhap dien tich duong tron:"))
  (command "circle" pt (sqrt (/ s pi)))
  (print (strcat "chu vi hinh tron la:" (rtos (* 2 pi (sqrt (/ s pi))))))
  (print)
  (command ".text" "j" "mc" pt 5 0 (strcat "chu vi hinh tron la:" (rtos (* 2 pi (sqrt (/ s pi))))))
  (end))
   
(defun c:ht(/ pt s) ;cach 2
  (start)
  (moment)
  (setq pt (getpoint "\nChon tam duong tron:"))
  (setq s (getreal "\nNhap dien tich duong tron:"))
  (command "circle" pt (sqrt (/ s pi)))
  (setq chon (entlast))
  (command ".area" "o" chon)
  (print (strcat "chu vi hinh tron la:" (rtos (getvar "perimeter"))))
  (print)
  (command ".text" "j" "mc" pt 5 0 (strcat "chu vi hinh tron la:" (rtos (getvar "perimeter"))))
  (end))

;cau 3
(defun c:vhcn(/ pt l h s)
  (start)
  (moment)
  (setq pt (getpoint "\nChon dinh dau:"))
  (setq l (getreal "\nNhap chieu dai hcn:"))
  (setq h (getreal "\nNhap chieu cao hcn:"))
  (setq s (* l h))
  (command "rectang" pt "a" s "l" l)
  (end))

;cau 4
(defun c:tgian()
  (start)
  (moment)
  (command ".text" "100,30" 5 0 (strcat "Nam: " (substr (rtos (getvar "cdate") 2 0) 1 4)))
  (command ".text" "100,20" 5 0 (strcat "Thang: " (substr (rtos (getvar "cdate") 2 0) 5 2)))
  (command ".text" "100,10" 5 0 (strcat "Ngay: " (substr (rtos (getvar "cdate") 2 0) 7 2)))
  (end))

(defun c:watch(/ pt1 pt2 ptt3 pt4); LAM THEM
  (start)
  (moment)
  (command "-layer" "m" "dim" "c" 2 "" "l" "continuous" "" "lw" 2 "" "")
  (command ".circle" "118,24" 30)
  (command "-layer" "m" "hatch" "c" 1 "" "l" "continuous" "" "lw" 0.3 "" "")
  (command ".text" "100,40" 7 0 "CADviet")
  (command "-layer" "m" "text" "c" 4 "" "l" "continuous" "" "lw" 0.2 "" "")
  (command ".text" "100,30" 5 0 (strcat "Nam: " (substr (rtos (getvar "cdate")) 1 4)))
  (command ".text" "100,20" 5 0 (strcat "Thang: " (substr (rtos (getvar "cdate")) 5 2)))
  (command ".text" "100,10" 5 0 (strcat "Ngay: " (substr (rtos (getvar "cdate")) 7 2)))
  (command ".text" "100,0" 5 0 (strcat "Gio: " (substr (rtos (getvar "cdate")) 10 2) ":" (substr (rtos (getvar "cdate")) 12 2)))
  (end))

;cau 5
(defun c:tronar(/ pt1 pt2 r g x chon)
  (start)
  (moment)
  (setq pt1 (getpoint "\nChon tam hinh tron:"))
  (setq r (getreal "\nNhap ban kinh hinh tron:"))
  (setq g (getreal "\nNhap goc ban dau cua line:"))
  (setq x (getint "\nNhap so phan chia duong tron:"))
  (setq pt2 (polar pt1 g  (* 2 r))) 
  (command ".circle" pt1  (* 2 r))
  (command ".line" pt1 pt2 "")
  (setq chon (entlast))
  (command ".array" chon "" "po" pt1 x "" "y" )
  (end))

<<

Filename: 315223_getvars_vht_ht_vhcn_tgian_watch_tronar.lsp
Tác giả: nhoclangbat
Bài viết gốc: 308742
Tên lệnh: laykk
Chữa BT Chương 4.2 : Xử lý chuỗi

hihi mí hôm nhóc bận làm hồ sơ nay mới rãnh ^^, ah đúng là thiếu bài cuối kéo chưa hết, a Ket cho nhoc nộp bài cuối hen

;ham lay ki tu cuoi cua chuoi
(defun c:laykk (/ str GetLchar)
(setq str (getstring 1 "\n nhap chuoi muon lay:"))
(defun GetLchar ( str / len)
(setq len (strlen str))
(substr str len 1))
(princ "\n")
(princ (strcat "ky tu cuoi la: " (GetLchar str)))
(princ)
)

- cái chia hình tròn thì nhoc quên ^^,...

>>

hihi mí hôm nhóc bận làm hồ sơ nay mới rãnh ^^, ah đúng là thiếu bài cuối kéo chưa hết, a Ket cho nhoc nộp bài cuối hen

;ham lay ki tu cuoi cua chuoi
(defun c:laykk (/ str GetLchar)
(setq str (getstring 1 "\n nhap chuoi muon lay:"))
(defun GetLchar ( str / len)
(setq len (strlen str))
(substr str len 1))
(princ "\n")
(princ (strcat "ky tu cuoi la: " (GetLchar str)))
(princ)
)

- cái chia hình tròn thì nhoc quên ^^, số phần mún chia nhoc nghĩ nên để số nguyên, ai mà chia lẽ đúng ko a Ket ^^, còn cái nhập góc có thể dùng getangle, thói quen nên wen hàm đó :))


<<

Filename: 308742_laykk.lsp
Tác giả: 18011985
Bài viết gốc: 99763
Tên lệnh: aaa
Xử lý List_box
Mình dùng list_box để thể hiện toạ độ điểm.
Khi dùng list_box có 1 vấn đề mình chưa hiểu, Khi mình nhập vào vị trí nó sẽ ra toạ độ. Nhưng các điểm trước sẽ bị đẩy xuống dưới, Mình muốn các điểm trước thì ở trên các điểm tiếp theo sẽ nối tiếp xuống dưới.
Sau đây là code của mình

Filename: 99763_aaa.lsp
Tác giả: nhoclangbat
Bài viết gốc: 315316
Tên lệnh: xem
Chữa BT Chương 4.2 : Xử lý chuỗi

- lúc trước vì xem bài bạn Hiep với Nam nhoc hoãn quá nào là if với 1 loạt các phép tính, nên xin anh Ket cho qua ^^ ,hi nay tự nhiên nhìn bài bạn Vinh lại có hứng với bài y/c tính thứ,  rãnh nên thử làm lại xem ^^, khả năng tính toán suy luận của nhoc còn yếu nhưng khả năng mò gu gồ cũng tàm tạm  :P

(defun c:xem (/ cdates nam ngay thang a b x thu)
(setq cdates (rtos (getvar...
>>

- lúc trước vì xem bài bạn Hiep với Nam nhoc hoãn quá nào là if với 1 loạt các phép tính, nên xin anh Ket cho qua ^^ ,hi nay tự nhiên nhìn bài bạn Vinh lại có hứng với bài y/c tính thứ,  rãnh nên thử làm lại xem ^^, khả năng tính toán suy luận của nhoc còn yếu nhưng khả năng mò gu gồ cũng tàm tạm  :P

(defun c:xem (/ cdates nam ngay thang a b x thu)
(setq cdates (rtos (getvar "cdate") 2 0)
      nam (atoi (substr cdates 1 4))
      a (atoi (substr cdates 1 2))
	  b (atoi (substr cdates 3 2))
	  ngay (atoi (substr cdates 7 2))
	  thang (atoi (substr cdates 5 2)))
(cond 
      ((= thang 1) (setq thang 13) (setq b (- b 1)))
	  ((= thang 2) (setq thang 14) (setq b (- b 1)))
)
(setq x (+ 1 (rem (+ (- (+ ngay 12 (fix (* 2.6 (+ thang 1)))) a) (fix (* 1.25 b))) 7)));=> cong thuc cua ong Gregory ^^
(if (= x 1) (setq thu "chu nhat") (setq thu (strcat "thu: " (itoa x))))
(cond ((= thang 13) (setq thang 1))
      ((= thang 14) (setq thang 2))
)
(alert (strcat "Hom nay la " thu "\n" (strcat "Ngay " (itoa ngay)) "\n" (strcat "Thang " (itoa thang)) "\n" (strcat "Nam " (itoa nam)))) 
)

P/s: xem như nhoc trả nợ bài cũ ^^


<<

Filename: 315316_xem.lsp
Tác giả: nhoclangbat
Bài viết gốc: 315590
Tên lệnh: dkk
Listp bảng tọa độ vn2000

- Như đã hứa, nhoc đã chỉnh xong theo y/c bạn Mse và bạn Ngochavn, điểm bắt đầu do người dùng quyết định, khi viết xong nhoc có test rùi thấy cũng tạm ổn, mặc dù cảm giác khả năng khắc phục lỗi của lsp chưa đc tốt ^^, khả năng nhoc tới mới đc vậy, nhoc mò cả tối qua với buổi sáng nay mới ra kaka , mong sao có a nào đi ngang hên xui thấy code nhoc viết ghê quá ngứa nghề sữa dùm nhoc cho nó...

>>

- Như đã hứa, nhoc đã chỉnh xong theo y/c bạn Mse và bạn Ngochavn, điểm bắt đầu do người dùng quyết định, khi viết xong nhoc có test rùi thấy cũng tạm ổn, mặc dù cảm giác khả năng khắc phục lỗi của lsp chưa đc tốt ^^, khả năng nhoc tới mới đc vậy, nhoc mò cả tối qua với buổi sáng nay mới ra kaka , mong sao có a nào đi ngang hên xui thấy code nhoc viết ghê quá ngứa nghề sữa dùm nhoc cho nó hoàn thiện hơn  :P , nói vậy thui chứ chạy cũng ổn nếu người dùng thao tác chính xác từng bước sẽ ko có lỗi, cái dở của nhoc là nếu người dùng lỡ tay hay nhầm thì cad báo lỗi thoát lệnh lun ^^.

- nhoc nói sơ từng bước các bạn dễ nắm: nhoc đã sửa lại không cần tạo ranh_38 trước, bạn cứ việc pick vào giữa khu đất ko quan tâm nó nằm ở layer nào, miễn vùng kín là đc

+ tên lệnh là dkk => xác định tỉ lệ bản đồ mặc định enter là 500

+ bước tiếp theo sẽ hỏi bạn chọn điểm đầu tiên như bạn yêu cầu

+ tiếp theo sẽ nhắc bạn chọn tâm thửa, pick vào vào bên trong thửa, để tránh lỗi bạn nên kiểm tra trước thửa đó có kín chưa = lệnh bo

+ tiếp (phần này nhoc thêm cho zui ^^) sẽ hỏi bạn mún chạy thuận hay nghịch chiều kim đồng hồ, từ khóa là "T" vs "N" = thuận với nghịch, mặc định nhoc đặt ko nhập gì enter lun là chạy thuận chiều đồng hồ, lsp sẽ tự động vẽ lại 1 pline kín theo ranh đất nằm ở layer "Ranh_dat" màu tím cho nó nổi ^^.

+ tiếp đó hỏi bạn điểm đặt bảng tọa độ => xong chương trình

- Ah còn vụ font thì do post code lên 4rum nó lỗi , bạn chịu khó sữa tay lại hen ^^, chỉnh lun thì để nhoc up lên trang khác để các bạn tải về, giờ nhoc up trực tiếp cái đã, cho bạn dùng thử, nếu có lỗi gì, hoặc mún thêm gì thông báo để nhoc ngâm cứu ^^, hoàn chỉnh sẽ up nguồn khác ko bị lỗi font nữa :)

(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)
;;-----------------------------------
(defun Wdis (p1 p2 / dis ang point point1)
  (setq dis (distance p1 p2))
  (setq ang (angle p1 p2))
  (if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
    (progn
      (setq ang (+ Ang Pi)) 
      (setq Point (polar p2 ang (/ dis 2.0)))
      (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))

    )
	(progn
    (setq Point (polar p1 ang (/ dis 2.0)))
    (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))
	)
  )
  (command "Text" "S" "vaptimn" "c" point1 (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2) )
)
;--------------------------------------------------------------------------
(defun pointpl (name t2 k / namem i bien t1 p1 diem)
	(setq namem name)
	(setq i 1)
	(while (<= i k)
	(progn
		(setq bien (assoc t2 namem))
		(setq t1 (member bien namem))
		(setq p1 (car t1))
		(setq namem (cdr t1))
		(setq diem (cdr p1))
		(setq i (+ 1 i))
	)
	)
	diem
);;;-----------------------------------------------------------------------------
(defun removed(part lst / lst1 lst2)
  (setq lst1 (reverse(cdr(member part(reverse lst))))
lst2 (cdr(member part lst)))
  (append lst1 lst2)
  )
;;;;;;--------------------------------------------------------------------------------------------
(prompt "LSP XUAT BANG TOA DO CAC DINH THU DAT, LENH: DKK")
;;----------------------------------------------------------------------------------------------
(defun c:dkk (/ p tam i f k lst1 lst2 lst i kk m b luuxy pt old pt11)
(setq old (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
;-----------------------------------------------------
(if (null (tblsearch "style" "vaptimn"))
		(command "style" "vaptimn" "vni-avo" "" "" "" "" ""))
	(if (null (tblsearch "style" "vhelveb"))
		(command "style" "vhelveb" "vni-helve" "" "" "" "" ""))
	(if (null (tblsearch "layer" "sohieu_diem"))
		(command "_layer" "n" "sohieu_diem" ""))
	(command "_layer" "c" "2" "sohieu_diem" "")
	(if (null (tblsearch "layer" "canh"))
		(command "_layer" "n" "canh" ""))
	(command "_layer" "c" "3" "canh" "")
	(if (null (tblsearch "layer" "bang_toado"))
		(command "_layer" "n" "bang_toado" ""))
	(command "_layer" "c" "7" "bang_toado" "")
	(command "_layer" "c" "6" "Ranh_toado" "")
	(if (null (tblsearch "layer" "Ranh_dat"))
		(command "_layer" "n" "Ranh_dat" ""))
	(command "_layer" "c" "6" "Ranh_dat" "")
	(if (not r1) (setq r1 500))
	(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
	(if (= TileBdHT nil)
		(setq TileBdHT r1))
;--------------------------------------------------------------------------
(setvar "osmode" 33)
(setq pt11 (removed 0.0 (getpoint "\nchon diem bat dau:")))
(setvar "osmode" 0)
(initget 1)
(setq p (getpoint "\npick tam thua:"))
(command "-Boundary" p "")
(setq tam (entget (entlast)))
(setq kk (cdr (assoc 90 tam)))
(command ".erase" "last" "")
(setq m 1)
(setq lst nil)

(repeat kk

(setq f (pointpl tam 10 m))
(setq m (1+ m))
(if f (setq lst (cons f lst)))

)
(if lst
(progn
(if (= (member pt11 lst) nil)
(alert "ban chua chon dung dinh thua dat\nban chay lai lenh tu dau hen thong cam ^^!!"))
(if (/= pt11 nil)
(progn
;------------------------===============================--------------------------------------
(setq bit (cond (bit) ("T")))
(initget "T N")
(setq	Tmp (strcat "\nBan muon chay Thuan hay Ngich chieu dong ho  <" bit ">: ")
	    bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "T")
(progn
(setq lst1 (member pt11 lst))
(setq lst2 (reverse (cdr (member pt11 (reverse lst)))))
(setq lst (append lst1 lst2))
)
(progn
(setq lst1 (member pt11 (reverse lst)))
(setq lst2 (reverse (cdr (member pt11 lst))))
(setq lst (append lst1 lst2))
)
)
;---------------------------------==============================-----------------------------------
(setq b 1)
(command "-layer" "s" "Ranh_dat" "")
(command ".pline")
(command (car lst))
(repeat (- kk 1)
(command (nth b lst))
(setq b (1+ b))
)
(command "c")
)
)
)
)
;--------------------------------------------------------------------------------------------------------
(if lst
(progn
(setq luuxy (entget (entlast)))
(setvar "osmode" 0)
	(setq pt (getpoint "\n Diem dat bang toa do :"))
	;(entdel (entlast))
	(setq k (cdr (assoc 90 luuxy)))
	(if (/= pt nil)
		(progn
			(setq p01 pt)
			(setq p02 (mapcar '+ pt '(10.0  0.0 0.0)))
			(setq p03 (mapcar '+ pt '(22.5 -2.5 0.0)))
			(setq p04 (mapcar '+ pt '(35.0  0.0 0.0)))
			(setq p05 (mapcar '+ pt '(45.0  0.0 0.0)))
			(setq p06 (mapcar '+ pt '(0.0 -5.0 0.0)))
			(setq p07 (mapcar '+ pt '(10.0 -2.5 0.0)))
			(setq p08 (mapcar '+ pt '(35.0 -2.5 0.0)))
			(setq p09 (mapcar '+ pt '(45.0 -5.0 0.0)))
			(if (<= k 10)			
				(progn
					(setq p10 (mapcar '+ pt '(0.0 -40.0 0.0)))
					(setq p11 (mapcar '+ pt '(10.0 -40.0 0.0)))
					(setq p12 (mapcar '+ pt '(22.5 -40.0 0.0)))
					(setq p13 (mapcar '+ pt '(35.0 -40.0 0.0)))
					(setq p14 (mapcar '+ pt '(45.0 -40.0 0.0)))
				)
				(progn
					(setq ty (* -1 (+ 10.0 (* k 3))))
					(setq t0 (list 0.0 ty 0.0))
					(setq t1 (list 10.0 ty 0.0))
					(setq t2 (list 22.5 ty 0.0))
					(setq t3 (list 35.0 ty 0.0))
					(setq t4 (list 45.0 ty 0.0))
					(setq p10 (mapcar '+ pt t0))
					(setq p11 (mapcar '+ pt t1))
					(setq p12 (mapcar '+ pt t2))
					(setq p13 (mapcar '+ pt t3))
					(setq p14 (mapcar '+ pt t4))
				)
			)
			(command "layer" "s" "bang_toado" "")
			(command "Line" p01 p05 "")
			(command "Line" p01 p10 "")
			(command "Line" p02 p11 "")
			(command "Line" p03 p12 "")
			(command "Line" p04 p13 "")
			(command "Line" p05 p14 "")
			(command "Line" p07 p08 "")
			(command "Line" p06 p09 "")
			(command "Line" p10 p14 "")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(22.5 2.0 0.0)) 1.25 0 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(5.0 -1.5 0.0)) 1.15 0 "Soá hieäu")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(5.0 -3.5 0.0)) 1.15 0 "ñieåm")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(22.5 -1.25 0.0)) 1.15 0 "Toïa ñoä")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(16.25 -3.75 0.0)) 1.15 0 "X(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(28.75 -3.75 0.0)) 1.25 0 "Y(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ pt '(40.0 -2.5 0.0)) 1.25 0 "Caïnh")
		)
	)
	(setq i 1)
	(while (<= i k)
		(progn
			(setq toado (pointpl luuxy 10 i))
			(setq x (rtos (car toado) 2 2))
			(setq y (rtos (cadr toado) 2 2))
			(command "layer" "s" "sohieu_diem" "")
			(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
			(command "Text" "S" "vaptimn" (mapcar '+ toado doi) (/ TileBdHT 500) 0 i)
			(command ".donut" 0 (* 0.25 (/ TileBdHT 500)) toado "")			
			(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
			(if (= i 1)
				(progn
					(setq toado1 toado)
					(setq x1 (rtos (car toado1) 2 2))
					(setq y1 (rtos (cadr toado1) 2 2))
				)
			)
			(if (>= i 2)
(progn
	(setq canh (distance toado0 toado))
	(command "layer" "s" "bang_toado" "")
	(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 2) )
	(command "layer" "s" "canh" "")
	(wdis toado0 toado)
)
			)
			(command "layer" "s" "bang_toado" "")
			(command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 i)
			(command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y)
			(command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x)
			(setq toado0 toado)
			(setq i (+ i 1))
		)
	)
	(command "layer" "s" "canh" "")
	(wdis toado toado1)
	(setq canh (distance toado toado1))
			(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
	(command "layer" "s" "bang_toado" "")
	(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 2) )
	(command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 "1")
	(command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y1)
	(command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x1)
)
(alert "chua lay dc danh sach toa do")
)
	(command "-layer" "s" "0" "")
	(setvar "osmode" old)
    (setvar "cmdecho" 1)
	(princ "\n")
	(princ)
)


P/s: mong nhận đc sự hài lòng từ người dùng  :P , mí a ghé ngang chém nhẹ tay hộ nhoc hen ^^


<<

Filename: 315590_dkk.lsp
Tác giả: luhaivinh
Bài viết gốc: 315629
Tên lệnh: getvars vht ht vhcn tgian thoig gio watch tronar lkt
Chữa BT Chương 4.2 : Xử lý chuỗi

hehe, cuối cùng cũng hoàn thiện bai làm. :D

Mình vừa xin được công thức của mấy bật tiền bối có đầy đủ thứ, ngày, tháng, giờ, năm .

Nhoc tham khảo xem sao :  (menucmd "M=$(edtime, $(getvar, date),DDDD - HH:MM AM/PM - DD/MO/YYYY)")

Em nộp bài luôn nha a Ket,

 

;chuong 4-2
(defun start()
  (setq oldcm (getvar "cmdecho"))
  (setq oldcl (getvar "clayer"))
  (setq oldos (getvar...
>>

hehe, cuối cùng cũng hoàn thiện bai làm. :D

Mình vừa xin được công thức của mấy bật tiền bối có đầy đủ thứ, ngày, tháng, giờ, năm .

Nhoc tham khảo xem sao :  (menucmd "M=$(edtime, $(getvar, date),DDDD - HH:MM AM/PM - DD/MO/YYYY)")

Em nộp bài luôn nha a Ket,

 

;chuong 4-2
(defun start()
  (setq oldcm (getvar "cmdecho"))
  (setq oldcl (getvar "clayer"))
  (setq oldos (getvar "osmode"))
  (setq oldab (getvar "angbase"))
  (setq oldad (getvar "angdir")))
(defun end()
  (setvar "cmdecho" oldcm)
  (setvar "clayer" oldcl)
  (setvar "osmode" oldos)
  (setvar "angbase" oldab)
  (setvar "angdir" oldad))
(defun moment()
  (setvar "cmdecho" 0)
  (setvar "osmode" 9)
  (setvar "angbase" 0)
  (setvar "angdir" 0))

;cau 1
(defun c:getvars()
  (print (strcat "Gia tri bien cmdecho la:" (itoa (getvar "cmdecho"))))
  (print (strcat "Gia tri bien osmode la:" (itoa (getvar "osmode"))))
  (print (strcat "Gia tri bien lunits la:" (itoa (getvar "lunits"))))
  (print (strcat "Gia tri bien luprec la:" (itoa (getvar "luprec"))))
  (print (strcat "Gia tri bien aunits la:"(itoa (getvar "aunits"))))
  (print (strcat "Gia tri bien auprec la:" (itoa (getvar "auprec"))))
  (print))
;cau 2
(defun c:vht(/ pt s) ;cach 1
  (start)
  (moment)
  (setq pt (getpoint "\nChon tam duong tron:"))
  (setq s (getreal "\nNhap dien tich duong tron:"))
  (command "circle" pt (sqrt (/ s pi)))
  (print (strcat "chu vi hinh tron la:" (rtos (* 2 pi (sqrt (/ s pi))))))
  (print)
  (command ".text" "j" "mc" pt 5 0 (strcat "chu vi hinh tron la:" (rtos (* 2 pi (sqrt (/ s pi))))))
  (end))
   
(defun c:ht(/ pt s) ;cach 2
  (start)
  (moment)
  (setq pt (getpoint "\nChon tam duong tron:"))
  (setq s (getreal "\nNhap dien tich duong tron:"))
  (command "circle" pt (sqrt (/ s pi)))
  (setq chon (entlast))
  (command ".area" "o" chon)
  (print (strcat "chu vi hinh tron la:" (rtos (getvar "perimeter"))))
  (print)
  (command ".text" "j" "mc" pt 5 0 (strcat "chu vi hinh tron la:" (rtos (getvar "perimeter"))))
  (end))

;cau 3
(defun c:vhcn(/ pt l h s)
  (start)
  (moment)
  (setq pt (getpoint "\nChon dinh dau:"))
  (setq l (getreal "\nNhap chieu dai hcn:"))
  (setq h (getreal "\nNhap chieu cao hcn:"))
  (setq s (* l h))
  (command "rectang" pt "a" s "l" l)
  (end))

;cau 4
(defun c:tgian(); cach 1
  (alert (strcat "Nam: " (substr (rtos (getvar "cdate") 2 0) 1 4)
	 "\n" (strcat "Thang: " (substr (rtos (getvar "cdate") 2 0) 5 2)
	 "\n" (strcat "Ngay: " (substr (rtos (getvar "cdate") 2 0) 7 2))))))

(defun c:thoig(); cach 2
  (start)
  (moment)
  (command ".text" "100,30" 5 0 (strcat "Nam: " (substr (rtos (getvar "cdate") 2 0) 1 4)))
  (command ".text" "100,20" 5 0 (strcat "Thang: " (substr (rtos (getvar "cdate") 2 0) 5 2)))
  (command ".text" "100,10" 5 0 (strcat "Ngay: " (substr (rtos (getvar "cdate") 2 0) 7 2)))
  (command "zoom" "e")
  (end))

(defun c:gio(); LAM THEM
  (setq lst (menucmd "M=$(edtime, $(getvar, date),DDDD - HH:MM AM/PM - DD/MO/YYYY)"))
  (alert (strcat "Nam: " (substr (rtos (getvar "cdate")) 1 4)
	 "\n" (strcat "Thang: " (substr (rtos (getvar "cdate")) 5 2)
	 "\n" (strcat "Ngay: " (substr (rtos (getvar "cdate")) 7 2)))
         "\n" (strcat "Gio: " (substr (rtos (getvar "cdate")) 10 2) ":" (substr (rtos (getvar "cdate")) 12 2))
	 "\n" (substr lst 1 8))))
(defun c:watch(/ lst); LAM THEM
  (start)
  (moment)
  (command "-layer" "m" "dim" "c" 2 "" "l" "continuous" "" "lw" 2 "" "")
  (command ".circle" "118,28" 35)
  (command "-layer" "m" "hatch" "c" 1 "" "l" "continuous" "" "lw" 0.3 "" "")
  (command ".text" "100,50" 5 0 "Thinh-Ngan")
  (command "-layer" "m" "text" "c" 4 "" "l" "continuous" "" "lw" 0.2 "" "")
  (command ".text" "100,30" 5 0 (strcat "Nam: " (substr (rtos (getvar "cdate")) 1 4)))
  (command ".text" "100,20" 5 0 (strcat "Thang: " (substr (rtos (getvar "cdate")) 5 2)))
  (command ".text" "100,10" 5 0 (strcat "Ngay: " (substr (rtos (getvar "cdate")) 7 2)))
  (command ".text" "100,0" 5 0 (strcat "Gio: " (substr (rtos (getvar "cdate")) 10 2) ":" (substr (rtos (getvar "cdate")) 12 2)))
  (setq lst (menucmd "M=$(edtime, $(getvar, date),DDDD - HH:MM AM/PM - DD/MO/YYYY)"))
  (command "text" "100,40" 5 0 (substr lst 1 8))
  (command "zoom" "e")
  (end))

;cau 5
(defun c:tronar(/ pt1 pt2 r g x chon)
  (start)
  (moment)
  (setq pt1 (getpoint "\nChon tam hinh tron:"))p
  (setq r (getreal "\nNhap ban kinh hinh tron:"))
  (setq g (getreal "\nNhap goc ban dau cua line:"))
  (setq x (getint "\nNhap so phan chia duong tron:"))
  (setq pt2 (polar pt1 g  (* 2 r))) 
  (command ".circle" pt1  (* 2 r))
  (command ".line" pt1 pt2 "")
  (setq chon (entlast))
  (command ".array" chon "" "po" pt1 x "" "y" )
  (end))

;cau 6
(defun c:lkt(/ GetLChar str)
  (setq str (getstring 1 "\nNhap chuoi:"))
  (defun GetLChar(str / n)
	  (setq n (strlen str))
	  (substr str n))
  (princ (strcat "ky tu cuoi cung cua chuoi la: " (GetLChar str)))
  (princ))

<<

Filename: 315629_getvars_vht_ht_vhcn_tgian_thoig_gio_watch_tronar_lkt.lsp
Tác giả: thanhduan2407
Bài viết gốc: 315677
Tên lệnh: tdkt
Listp bảng tọa độ vn2000

Đây. ^^

(vl-load-com)
(defun C:TDKT (/ Olmode STT loop TD_Point Lts Pnt P_dat n i P1 P2 P3 P4 P_cuoi P_Text Pdat_KC  CDKC  Pnt_i P_i P_i_1  Pnt_KC Lts1);;;;;TOA DO KICH THUOC
(setvar "CMDECHO" 0)
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(or *h* (setq *h* 2))
(setq h (getreal (strcat "\nNh\U+1EADp...
>>

Đây. ^^

(vl-load-com)
(defun C:TDKT (/ Olmode STT loop TD_Point Lts Pnt P_dat n i P1 P2 P3 P4 P_cuoi P_Text Pdat_KC  CDKC  Pnt_i P_i P_i_1  Pnt_KC Lts1);;;;;TOA DO KICH THUOC
(setvar "CMDECHO" 0)
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(or *h* (setq *h* 2))
(setq h (getreal (strcat "\nNh\U+1EADp chi\U+1EC1u cao Text <"
		  (rtos *h* 2 2)
		 "> :"
	  )
 )
)
(if (not h) (setq h *h*) (setq *h* h))
(setvar "OSMODE" 9)
(setq STT 1)
(setq loop T)
(setq TD_Point (list))
(setq Lts (list))
(_layer2  "Heaven2407" 2)
(while loop
	(setq Pnt (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m : "))
  	(cond
	  (T
		(if Pnt
		  (progn
		    	
;;;	    	  	(setq P_STT (Polar3 Pnt 0 (/ h 2.0)))
		    	(setq P_STT (Polar3 Pnt 0 0))
  			(wtxt (rtos STT 2 0) P_STT (* h 2.0) 0 "L" "Heaven2407")
		  	(setq TD_Point (list STT (list (car Pnt) (cadr Pnt))))
		    	(setq Lts (append Lts (list TD_Point)))
		    	
		  )
		  (setq loop nil)
		)
	  )
	)
  	(setq STT (1+ STT))
  	
)
(setq n (length Lts))
(setq P_dat (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n b\U+1EA3ng t\U+1ECDa \U+0111\U+1ED9 v\U+00E0 k\U+00EDch th\U+01B0\U+1EDBc: "))
(setq i 0)
(setq P1 (Polar3 P_dat (* 4.0 h) 0))
(setq P2 (Polar3 P1 (* h 8.0) 0))
(setq P3 (Polar3 P2 (* h 8.0) 0))
(setq P4 (Polar3 P3 (* h 6.0) 0))
(setq P_cuoi (Polar3 P_dat 0 (+ (* (* -2.0 h) (+ n 1)) 1)))
(entmake (list (cons 0 "LINE") (cons 10 P_dat) (cons 11 P4)))
(entmake (list (cons 0 "LINE") (cons 10 P_dat) (cons 11 P_cuoi)))
(entmake (list (cons 0 "LINE") (cons 10 P_cuoi) (cons 11 (list (car P4) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 (list (car P4) (cadr P_cuoi))) (cons 11 P4)))
(entmake (list (cons 0 "LINE") (cons 10 P1) (cons 11 (list (car P1) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 P2) (cons 11 (list (car P2) (cadr P_cuoi)))))
(entmake (list (cons 0 "LINE") (cons 10 P3) (cons 11 (list (car P3) (cadr P_cuoi)))))
(setq P_Text (Polar3 P_dat (* h 2.0) (* h -2.0)))
(setq Pdat_KC (Polar3 P_Text (* h 21.0) (* h -1.0)))
(setq PLine_ngangdau (Polar3 P_dat 0.0 (* h -2.25)))
(while (< i (- n 1))
  	(setq P1 (car (cdr (nth i Lts))))
  	(setq P2  (car (cdr (nth (+ i 1) Lts))))
  	(setq KCLT  (distance P1 P2))
  
  
  	;;;GHI SO THU TU
  	(setq Pnt_i (Polar3 P_Text 0.0 (* i (* h -2.0))))
  	(setq NDSTT (car (nth i Lts)))
	(wtxt (rtos NDSTT 2 0) Pnt_i h 0 "BC" nil)

  	;;;GHI TOA DO X
	(setq Pnt_i_X (Polar3 P_Text (* h 6.0) (* i (* -2.0 h))))
  	(setq TD_X (car P1))
	(wtxt (rtos TD_X 2 2) Pnt_i_X h 0 "BC" nil)

  	;;;GHI TOA DO Y
	(setq Pnt_i_Y (Polar3 P_Text (* h 14.0) (* i (* -2.0 h))))
  	(setq TD_Y (cadr P1))
	(wtxt (rtos TD_Y 2 2) Pnt_i_Y h 0 "BC" nil)

  	;;;GHI KHOANG CACH
	(setq Pnt_KC (Polar3 Pdat_KC 0.0 (* i (* -2.0 h))))
	(wtxt (rtos KCLT 2 2) Pnt_KC h 0 "BC" nil)


  	;;KE LINE NGANG
	(setq P_Line (Polar3 PLine_ngangdau 0 (* i (* h -2.0))))
  	(entmake (list (cons 0 "LINE") (cons 10 P_Line) (cons 11 (list (car P3) (cadr P_Line) ))))
	
(setq i (1+ i))
)
  	;;;GHI SO THU TU
  	(setq Pnt_i1 (Polar3 P_Text 0 (* (- n 1) (* -2.0 h))))
  	(setq NDSTT1 (car (nth 0 Lts)))
	(wtxt (rtos NDSTT1 2 0) Pnt_i1 h 0 "C" nil)

  	;;;GHI TOA DO X
	(setq Pnt_i_X1 (Polar3 P_Text (*  h 6.0) (* (- n 1) (* h -2.0))))
  	(setq TD_X1 (car (car (cdr (nth 0 Lts)))))
	(wtxt (rtos TD_X1 2 2) Pnt_i_X1 h 0 "C" nil)

  	;;;GHI TOA DO Y
	(setq Pnt_i_Y1 (Polar3 P_Text (* h 14.0) (* (- n 1) (* -2.0 h))))
  	(setq TD_Y1 (cadr (car (cdr (nth 0 Lts)))))
	(wtxt (rtos TD_Y1 2 2) Pnt_i_Y1 h 0 "C" nil)

  
(setvar "OSMODE" Olmode)
;;;(princ Lts1)
(princ)
)

(defun Polar3 (Pnt KC1 KC2 /  P1)
	(setq P1 (list (+ (car Pnt) KC1) (+ (cadr Pnt) KC2)))
)

(defun wtxt (string Point Height Ang justify Layer / 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)
)


(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)

<<

Filename: 315677_tdkt.lsp
Tác giả: nhoclangbat
Bài viết gốc: 315808
Tên lệnh: dkk
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

- mấy anh xem dùm lsp  nhoc sửa với, nhoc test mún nát cad lun rùi ^^ mà hình như vẫn lỗi gì đó khó hỉu lắm, cùng 1 hình 1 điểm khi chọn điểm đầu tiên, có lúc nó nhận đc điểm đó đúng trong list chạy ngon lành, có lúc lại không nhận đc @@, rùi chạy lại từ đầu thì lại đc @@, nhoc cũng thử kiểm tra tọa độ pick với list tọa độ thu đc từ lệnh bo, xem có sự sai lệch ko, nhưng test mấy lần...

>>

- mấy anh xem dùm lsp  nhoc sửa với, nhoc test mún nát cad lun rùi ^^ mà hình như vẫn lỗi gì đó khó hỉu lắm, cùng 1 hình 1 điểm khi chọn điểm đầu tiên, có lúc nó nhận đc điểm đó đúng trong list chạy ngon lành, có lúc lại không nhận đc @@, rùi chạy lại từ đầu thì lại đc @@, nhoc cũng thử kiểm tra tọa độ pick với list tọa độ thu đc từ lệnh bo, xem có sự sai lệch ko, nhưng test mấy lần điểm pick vẫn thuộc list mà nó lại chạy thẳng xuống vế  "ko thì" của if :(

- mấy hàm các anh gợi ý cho nhoc, nhoc vẫn chưa pit áp dụng thế nào ^^

(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)
;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
	(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
	(entmakex Lst))
	;end;=================================
;;;;------------------------------------------
;;ham tao text 2
(defun mktext (point height string justify layer textstyle / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 textstyle)
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 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)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;;-----------------------------------
(defun Wdis (p1 p2 / dis ang point point1)
  (setq dis (distance p1 p2))
  (setq ang (angle p1 p2))
  (if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
    (progn
      (setq ang (+ Ang Pi)) 
      (setq Point (polar p2 ang (/ dis 2.0)))
      (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))

    )
	(progn
    (setq Point (polar p1 ang (/ dis 2.0)))
    (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))
	)
  )
  (command "Text" "S" "vaptimn" "c" point1 (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2))
)
;--------------------------------------------------------------------------
(defun pointpl (name t2 k / namem i bien t1 p1 diem)
	(setq namem name)
	(setq i 1)
	(while (<= i k)
	(progn
		(setq bien (assoc t2 namem))
		(setq t1 (member bien namem))
		(setq p1 (car t1))
		(setq namem (cdr t1))
		(setq diem (cdr p1))
		(setq i (+ 1 i))
	)
	)
	diem
);;;-----------------------------------------------------------------------------
(defun removed(part lst / lst1 lst2)
  (setq lst1 (reverse(cdr(member part(reverse lst))))
lst2 (cdr(member part lst)))
  (append lst1 lst2)
  )
;hàm tạo textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;;;;;;--------------------------------------------------------------------------------------------
(prompt "LSP XUAT BANG TOA DO CAC DINH THU DAT, LENH: DKK")
;;----------------------------------------------------------------------------------------------
(defun c:dkk (/ p tam i f k lst1 lst2 lst lst_new i kk m luuxy pt pt11 old  canh p01 p02 p03 p04 p05 p06 p07 p08 p09 p10 p11 p12 p13 p14 x x1 y y1 toado toado0 toado1 pyy pxx psh pgc t0 t1 t2 t3 t4 y tsh txx tyy tgc)
(setq old (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
;-----------------------------------------------------
(if (null (tblsearch "style" "vaptimn"))
		(emk_style "vaptimn" "vavon.ttf"))
	(if (null (tblsearch "style" "vhelveb"))
		(emk_style "vhelveb" "vhelven.TTF"))
	(if (null (tblsearch "layer" "sohieu_diem"))
		(_layer2 "sohieu_diem" 2))
    (if (null (tblsearch "layer" "canh"))
		(_layer2 "canh" 3))
	(if (null (tblsearch "layer" "bang_toado"))
		(_layer2 "bang_toado" 7))
	(if (null (tblsearch "layer" "Ranh_dat"))
		(_layer2 "Ranh_dat" 6))
	(if (not r1) (setq r1 500))
	(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
	(if (= TileBdHT nil)
		(setq TileBdHT r1))
;--------------------------------------------------------------------------
(setvar "osmode" 33)
(setq pt11 (removed 0.0 (getpoint "\nchon diem bat dau:")))
(setvar "osmode" 0)
(setq p (getpoint "\npick tam thua:"))
(command "-Boundary" p "")
(setq tam (entget (entlast)))
(setq kk (cdr (assoc 90 tam)))
(command ".erase" "last" "")
(setq m 1)
(setq lst nil)

(repeat kk
(setq f (pointpl tam 10 m))
(setq m (1+ m))
(if f (setq lst (cons f lst)))
)

;------------------------------------------==========================================---------------------------------
(if (= (type (member pt11 lst)) 'LIST)
;;====================-----------------------------======================================-----------------------
(progn
;--------------------====================================------------------------------------
(if (/= lst nil)
(progn
;------------------------===============================--------------------------------------
(setq bit (cond (bit) ("T")))
(initget "T N")
(setq	Tmp (strcat "\nBan muon chay Thuan hay Ngich chieu dong ho  <" bit ">: ")
	    bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "T")
(progn
(setq lst1 (member pt11 lst))
(setq lst2 (reverse (cdr (member pt11 (reverse lst)))))
(setq lst_new (append lst1 lst2))
)
(progn
(setq lst1 (member pt11 (reverse lst)))
(setq lst2 (reverse (cdr (member pt11 lst))))
(setq lst_new (append lst1 lst2))
)
)
;---------------------------------==============================-----------------------------------
(Makepline lst_new 1 "Ranh_dat" nil nil nil)
;----------------------------=========================================--------------------------
)
)
;--------------------------------------------------------------------------------------------------------
(setq luuxy (entget (entlast)))
(setvar "osmode" 0)
	(setq pt (getpoint "\n Diem dat bang toa do :"))
	(setq k (cdr (assoc 90 luuxy)))
	(if (/= pt nil)
		(progn
			(setq p01 pt)
			(setq p02 (mapcar '+ pt '(10.0  0.0 0.0)))
			(setq p03 (mapcar '+ pt '(22.5 -2.5 0.0)))
			(setq p04 (mapcar '+ pt '(35.0  0.0 0.0)))
			(setq p05 (mapcar '+ pt '(45.0  0.0 0.0)))
			(setq p06 (mapcar '+ pt '(0.0 -5.0 0.0)))
			(setq p07 (mapcar '+ pt '(10.0 -2.5 0.0)))
			(setq p08 (mapcar '+ pt '(35.0 -2.5 0.0)))
			(setq p09 (mapcar '+ pt '(45.0 -5.0 0.0)))
			(if (<= k 10)			
				(progn
					(setq p10 (mapcar '+ pt '(0.0 -40.0 0.0)))
					(setq p11 (mapcar '+ pt '(10.0 -40.0 0.0)))
					(setq p12 (mapcar '+ pt '(22.5 -40.0 0.0)))
					(setq p13 (mapcar '+ pt '(35.0 -40.0 0.0)))
					(setq p14 (mapcar '+ pt '(45.0 -40.0 0.0)))
				)
				(progn
					(setq ty (* -1 (+ 10.0 (* k 3))))
					(setq t0 (list 0.0 ty 0.0))
					(setq t1 (list 10.0 ty 0.0))
					(setq t2 (list 22.5 ty 0.0))
					(setq t3 (list 35.0 ty 0.0))
					(setq t4 (list 45.0 ty 0.0))
					(setq p10 (mapcar '+ pt t0))
					(setq p11 (mapcar '+ pt t1))
					(setq p12 (mapcar '+ pt t2))
					(setq p13 (mapcar '+ pt t3))
					(setq p14 (mapcar '+ pt t4))
				)
			)
			
			(makeline p01 p05 "bang_toado" nil nil nil)
			(makeline p01 p10 "bang_toado" nil nil nil)
			(makeline p02 p11 "bang_toado" nil nil nil)
			(makeline p03 p12 "bang_toado" nil nil nil)
			(makeline p04 p13 "bang_toado" nil nil nil)
			(makeline p05 p14 "bang_toado" nil nil nil)
			(makeline p07 p08 "bang_toado" nil nil nil)
			(makeline p06 p09 "bang_toado" nil nil nil)
			(makeline p10 p14 "bang_toado" nil nil nil)
;------------------------------------------------------------------------------------------------------------------
(mktext (mapcar '+ pt '(22.5 2.0 0.0)) 1.25 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -1.5 0.0)) 1.15 "Soá hieäu" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -3.5 0.0)) 1.15 "ñieåm" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(22.5 -1.25 0.0)) 1.15 "Toïa ñoä" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(16.25 -3.75 0.0)) 1.15 "X(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(28.75 -3.75 0.0)) 1.25 "Y(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(40.0 -2.5 0.0)) 1.25 "Caïnh" "M" "bang_toado" "vhelveb")
;-------------------====================--------------------------------------------------------------------------
		)
	)
	(setq i 1)
	(while (<= i k)
		(progn
			(setq toado (pointpl luuxy 10 i))
			(setq x (rtos (car toado) 2 2))
			(setq y (rtos (cadr toado) 2 2))
			(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
			(mktext (mapcar '+ toado doi) (/ TileBdHT 500) (itoa i) "L" "sohieu_diem" "vaptimn")
            (command "-layer" "s" "sohieu_diem" "")			
			(command ".donut" 0 (* 0.25 (/ TileBdHT 500)) toado "")			
			(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
			(if (= i 1)
				(progn
					(setq toado1 toado)
					(setq x1 (rtos (car toado1) 2 2))
					(setq y1 (rtos (cadr toado1) 2 2))
				)
			)
			(if (>= i 2)
(progn
	(setq canh (distance toado0 toado))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(setvar "clayer" "canh")
	(wdis toado0 toado)
)
			)
			(mktext psh 1.2 (itoa i) "M" "bang_toado" "vaptimn")
			(mktext pxx 1.2 y "M" "bang_toado" "vaptimn")
			(mktext pyy 1.2 x "M" "bang_toado" "vaptimn")
			
			(setq toado0 toado)
			(setq i (+ i 1))
		)
	)
	(setvar "clayer" "canh")
	(wdis toado toado1)
	(setq canh (distance toado toado1))
			(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(mktext psh 1.2 "1" "M" "bang_toado" "vaptimn")
	(mktext pxx 1.2 y1 "M" "bang_toado" "vaptimn")
	(mktext pyy 1.2 x1 "M" "bang_toado" "vaptimn")
	
)
(alert "ban chua chon dung dinh thua dat\nban chay lai lenh tu dau hen thong cam ^^!!")
)
	(setvar "clayer" "0")
	(setvar "osmode" old)
    (setvar "cmdecho" 1)
	(princ "\n")
	(princ)
)


<<

Filename: 315808_dkk.lsp
Tác giả: Tot77
Bài viết gốc: 315813
Tên lệnh: dac
Đánh cao độ cho mặt cắt

Bạn dùng cái này, quét các line rồi chọn 1 text cao độ chuẩn (ở đây là 80).

Trước khi chạy lsp bạn nên purge để xóa bớt các line trùng nhau, vì cứ 1 line sẽ có 2 text 2 bên.

(defun c:dac ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun viet (nd pt tr)
    (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 11 pt) (cons 71 0) (cons 40 cao)
  (cons 73 0) (cons 72 (if tr 2 0))...
>>

Bạn dùng cái này, quét các line rồi chọn 1 text cao độ chuẩn (ở đây là 80).

Trước khi chạy lsp bạn nên purge để xóa bớt các line trùng nhau, vì cứ 1 line sẽ có 2 text 2 bên.

(defun c:dac ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun viet (nd pt tr)
    (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 11 pt) (cons 71 0) (cons 40 cao)
  (cons 73 0) (cons 72 (if tr 2 0)) (cons 1 nd))) 
  )
  (defun chan(x n) (* n (if (< (rem x n) (* 0.5 n)) (fix (/ x n 1.)) (1+ (fix (/ x n 1.))))))
  
  (prompt "\nChon line:")
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE"))))))
ss (vl-remove-if-not '(lambda (x) (equal (cadr (dxf 10 x)) (cadr (dxf 11 x)) 1)) ss)
ss0 (cadr (dxf 10 (car (vl-sort ss '(lambda (x y) (< (cadr (dxf 10 x)) (cadr (dxf 10 y))))))))
tx (car (entsel "\nChon Text cao do chuan :"))
tt1 (chan (atof (dxf 1 tx)) 10)
cao (dxf 40 tx)
  )
  (foreach v ss
    (if (> (vlax-curve-getDistAtParam v (vlax-curve-getEndParam v)) 5)
      (progn
(setq nd (itoa (chan (+ tt1 (- (cadr (dxf 10 v)) ss0)) 10))
     tt (vl-sort (list (dxf 10 v) (dxf 11 v)) '(lambda (x y) (< (car x) (car y)))))       
(viet nd (car tt) t)
(viet nd (last tt) nil)
      )
   )
  ) (princ)
)

<<

Filename: 315813_dac.lsp
Tác giả: nhoclangbat
Bài viết gốc: 315819
Tên lệnh: dkk
Listp bảng tọa độ vn2000

- mấy bạn chạy test hộ nhoc còn lsp còn lỗi ko nhé ^^

(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)
;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale...
>>

- mấy bạn chạy test hộ nhoc còn lsp còn lỗi ko nhé ^^

(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)
;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
	(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
	(entmakex Lst))
	;end;=================================
;;;;------------------------------------------
;;ham tao text 2
(defun mktext (point height string justify layer textstyle / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 textstyle)
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 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)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;;-----------------------------------
(defun Wdis (p1 p2 / dis ang point point1)
  (setq dis (distance p1 p2))
  (setq ang (angle p1 p2))
  (if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
    (progn
      (setq ang (+ Ang Pi)) 
      (setq Point (polar p2 ang (/ dis 2.0)))
      (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))

    )
	(progn
    (setq Point (polar p1 ang (/ dis 2.0)))
    (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))
	)
  )
  (command "Text" "S" "vaptimn" "c" point1 (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2))
)
;--------------------------------------------------------------------------
(defun pointpl (name t2 k / namem i bien t1 p1 diem)
	(setq namem name)
	(setq i 1)
	(while (<= i k)
	(progn
		(setq bien (assoc t2 namem))
		(setq t1 (member bien namem))
		(setq p1 (car t1))
		(setq namem (cdr t1))
		(setq diem (cdr p1))
		(setq i (+ 1 i))
	)
	)
	diem
);;;-----------------------------------------------------------------------------
(defun removed(part lst / lst1 lst2)
  (setq lst1 (reverse(cdr(member part(reverse lst))))
lst2 (cdr(member part lst)))
  (append lst1 lst2)
  )
;hàm tạo textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil)))))
;;;;;;--------------------------------------------------------------------------------------------
(prompt "LSP XUAT BANG TOA DO CAC DINH THU DAT, LENH: DKK")
;;----------------------------------------------------------------------------------------------
(defun c:dkk (/ p tam i f k lst1 lst2 lst pt11 lst_new i kk m luuxy pt old  canh p01 p02 p03 p04 p05 p06 p07 p08 p09 p10 p11 p12 p13 p14 x x1 y y1 toado toado0 toado1 pyy pxx psh pgc t0 t1 t2 t3 t4 y tsh txx tyy tgc)
(setq old (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
;-----------------------------------------------------
(if (null (tblsearch "style" "vaptimn"))
		(emk_style "vaptimn" "vavon.ttf"))
	(if (null (tblsearch "style" "vhelveb"))
		(emk_style "vhelveb" "vhelven.TTF"))
	(if (null (tblsearch "layer" "sohieu_diem"))
		(_layer2 "sohieu_diem" 2))
    (if (null (tblsearch "layer" "canh"))
		(_layer2 "canh" 3))
	(if (null (tblsearch "layer" "bang_toado"))
		(_layer2 "bang_toado" 7))
	(if (null (tblsearch "layer" "Ranh_dat"))
		(_layer2 "Ranh_dat" 6))
	(if (not r1) (setq r1 500))
	(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
	(if (= TileBdHT nil)
		(setq TileBdHT r1))
;--------------------------------------------------------------------------
(setvar "osmode" 33)
(setq pt11 (getpoint "\nchon diem bat dau:"))
(setq pt11 (removed 0.0 pt11))
(setvar "osmode" 0)
(setq p (getpoint "\npick tam thua:"))
(command "-Boundary" p "")
(setq tam (entget (entlast)))
(setq kk (cdr (assoc 90 tam)))
(command ".erase" "last" "")
(setq m 1)
(setq lst nil)

(repeat kk
(setq f (pointpl tam 10 m))
(setq m (1+ m))
(if f (setq lst (cons f lst)))
)

;------------------------------------------==========================================---------------------------------
(if (= (type (member pt11 lst)) 'LIST)
;;====================-----------------------------======================================-----------------------
(progn
;--------------------====================================------------------------------------
(if lst
(progn
;------------------------===============================--------------------------------------
(setq bit (cond (bit) ("T")))
(initget "T N")
(setq	Tmp (strcat "\nBan muon chay Thuan hay Ngich chieu dong ho  <" bit ">: ")
	    bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "T")
(progn
(setq lst1 (member pt11 lst))
(setq lst2 (reverse (cdr (member pt11 (reverse lst)))))
(setq lst_new (append lst1 lst2))
)
(progn
(setq lst1 (member pt11 (reverse lst)))
(setq lst2 (reverse (cdr (member pt11 lst))))
(setq lst_new (append lst1 lst2))
)
)
;---------------------------------==============================-----------------------------------
(Makepline lst_new 1 "Ranh_dat" nil nil nil)
;----------------------------=========================================--------------------------
)
)
;--------------------------------------------------------------------------------------------------------
(setq luuxy (entget (entlast)))
(setvar "osmode" 0)
	(setq pt (getpoint "\n Diem dat bang toa do :"))
	(setq k (cdr (assoc 90 luuxy)))
	(if (/= pt nil)
		(progn
			(setq p01 pt)
			(setq p02 (mapcar '+ pt '(10.0  0.0 0.0)))
			(setq p03 (mapcar '+ pt '(22.5 -2.5 0.0)))
			(setq p04 (mapcar '+ pt '(35.0  0.0 0.0)))
			(setq p05 (mapcar '+ pt '(45.0  0.0 0.0)))
			(setq p06 (mapcar '+ pt '(0.0 -5.0 0.0)))
			(setq p07 (mapcar '+ pt '(10.0 -2.5 0.0)))
			(setq p08 (mapcar '+ pt '(35.0 -2.5 0.0)))
			(setq p09 (mapcar '+ pt '(45.0 -5.0 0.0)))
			(if (<= k 10)			
				(progn
					(setq p10 (mapcar '+ pt '(0.0 -40.0 0.0)))
					(setq p11 (mapcar '+ pt '(10.0 -40.0 0.0)))
					(setq p12 (mapcar '+ pt '(22.5 -40.0 0.0)))
					(setq p13 (mapcar '+ pt '(35.0 -40.0 0.0)))
					(setq p14 (mapcar '+ pt '(45.0 -40.0 0.0)))
				)
				(progn
					(setq ty (* -1 (+ 10.0 (* k 3))))
					(setq t0 (list 0.0 ty 0.0))
					(setq t1 (list 10.0 ty 0.0))
					(setq t2 (list 22.5 ty 0.0))
					(setq t3 (list 35.0 ty 0.0))
					(setq t4 (list 45.0 ty 0.0))
					(setq p10 (mapcar '+ pt t0))
					(setq p11 (mapcar '+ pt t1))
					(setq p12 (mapcar '+ pt t2))
					(setq p13 (mapcar '+ pt t3))
					(setq p14 (mapcar '+ pt t4))
				)
			)
			
			(makeline p01 p05 "bang_toado" nil nil nil)
			(makeline p01 p10 "bang_toado" nil nil nil)
			(makeline p02 p11 "bang_toado" nil nil nil)
			(makeline p03 p12 "bang_toado" nil nil nil)
			(makeline p04 p13 "bang_toado" nil nil nil)
			(makeline p05 p14 "bang_toado" nil nil nil)
			(makeline p07 p08 "bang_toado" nil nil nil)
			(makeline p06 p09 "bang_toado" nil nil nil)
			(makeline p10 p14 "bang_toado" nil nil nil)
;------------------------------------------------------------------------------------------------------------------
(mktext (mapcar '+ pt '(22.5 2.0 0.0)) 1.25 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -1.5 0.0)) 1.15 "Soá hieäu" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -3.5 0.0)) 1.15 "ñieåm" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(22.5 -1.25 0.0)) 1.15 "Toïa ñoä" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(16.25 -3.75 0.0)) 1.15 "X(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(28.75 -3.75 0.0)) 1.25 "Y(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(40.0 -2.5 0.0)) 1.25 "Caïnh" "M" "bang_toado" "vhelveb")
;-------------------====================--------------------------------------------------------------------------
		)
	)
	(setq i 1)
	(while (<= i k)
		(progn
			(setq toado (pointpl luuxy 10 i))
			(setq x (rtos (car toado) 2 2))
			(setq y (rtos (cadr toado) 2 2))
			(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
			(mktext (mapcar '+ toado doi) (/ TileBdHT 500) (itoa i) "L" "sohieu_diem" "vaptimn")
            (command "-layer" "s" "sohieu_diem" "")			
			(command ".donut" 0 (* 0.25 (/ TileBdHT 500)) toado "")			
			(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
			(if (= i 1)
				(progn
					(setq toado1 toado)
					(setq x1 (rtos (car toado1) 2 2))
					(setq y1 (rtos (cadr toado1) 2 2))
				)
			)
			(if (>= i 2)
(progn
	(setq canh (distance toado0 toado))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(setvar "clayer" "canh")
	(wdis toado0 toado)
)
			)
			(mktext psh 1.2 (itoa i) "M" "bang_toado" "vaptimn")
			(mktext pxx 1.2 y "M" "bang_toado" "vaptimn")
			(mktext pyy 1.2 x "M" "bang_toado" "vaptimn")
			
			(setq toado0 toado)
			(setq i (+ i 1))
		)
	)
	(setvar "clayer" "canh")
	(wdis toado toado1)
	(setq canh (distance toado toado1))
			(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(mktext psh 1.2 "1" "M" "bang_toado" "vaptimn")
	(mktext pxx 1.2 y1 "M" "bang_toado" "vaptimn")
	(mktext pyy 1.2 x1 "M" "bang_toado" "vaptimn")
	
)
(alert "ban chua chon dung dinh thua dat\nban chay lai lenh tu dau hen thong cam ^^!!")
)
	(setvar "clayer" "0")
	(setvar "osmode" old)
    (setvar "cmdecho" 1)
	(princ "\n")
	(princ)
)


<<

Filename: 315819_dkk.lsp
Tác giả: Tot77
Bài viết gốc: 315897
Tên lệnh: dac
Đánh cao độ cho mặt cắt

Cái này dùng cho cả line và pline, nhưng chỉ với pline 1 đoạn thẳng với 2 đỉnh mà thôi.

Còn chữ thì tôi cho cách 5 giống hình bên phải, nếu muốn sửa thì thay số 5 ở gần cuối (5 và -5).

(defun c:dac ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun viet (nd pt tr)
    (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 11 pt) (cons 71 0) (cons 40 cao)
  (cons 73 0) (cons 72...
>>

Cái này dùng cho cả line và pline, nhưng chỉ với pline 1 đoạn thẳng với 2 đỉnh mà thôi.

Còn chữ thì tôi cho cách 5 giống hình bên phải, nếu muốn sửa thì thay số 5 ở gần cuối (5 và -5).

(defun c:dac ()
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun viet (nd pt tr)
    (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 11 pt) (cons 71 0) (cons 40 cao)
  (cons 73 0) (cons 72 (if tr 2 0)) (cons 1 nd))) 
  )
  (defun chan(x n) (* n (if (< (rem x n) (* 0.5 n)) (fix (/ x n 1.)) (1+ (fix (/ x n 1.))))))
  
  (prompt "\nChon line hoac pline:")
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "*LINE"))))))
ss (vl-remove-if-not '(lambda (x) (and (or (= 1 (vlax-curve-getEndParam x)) (= "LINE" (dxf 0 x)))
      (equal (cadr (vlax-curve-getStartpoint x))
     (cadr (vlax-curve-getEndpoint x)) 1))) ss)
ss0 (cadr (dxf 10 (car (vl-sort ss '(lambda (x y) (< (cadr (dxf 10 x)) (cadr (dxf 10 y))))))))
tx (car (entsel "\nChon Text cao do chuan :"))
tt1 (chan (atof (dxf 1 tx)) 10)
cao (dxf 40 tx)
  )
  (foreach v ss
    (if (> (vlax-curve-getDistAtParam v (vlax-curve-getEndParam v)) 5)
      (progn
(setq nd (itoa (chan (+ tt1 (- (cadr (dxf 10 v)) ss0)) 10))
     tt (vl-sort (list (vlax-curve-getStartpoint v) (vlax-curve-getEndpoint v))
 '(lambda (x y) (< (car x) (car y)))))
(viet nd (polar (car tt) 0 -5) t)
(viet nd (polar (last tt) 0 5) nil)
      )
   )
  ) (princ)
)

<<

Filename: 315897_dac.lsp
Tác giả: thanhduan2407
Bài viết gốc: 315898
Tên lệnh: sxk
Nhờ viết lisp tạo khung in bình đồ dạng tuyến
(vl-load-com)
(load "aspace.lsp")
(defun c:SXK() ;;;SAP XEP KHUNG
(load "aspace.lsp");;;LOAD LISP ASPACE DE SU DUNG HAM "alignspace" - 1 HAM CO SAN TRONG EXPRESS TOOL
;;;;;;;;;;;;;;;;;;;;;;;;;;;HAM *ERROR* NAY CO TAC DUNG KHI HUY LENH GIUA CHUNG SE VAN GIU NGUYEN CAC THAM SO OSNAP;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg...
>>
(vl-load-com)
(load "aspace.lsp")
(defun c:SXK() ;;;SAP XEP KHUNG
(load "aspace.lsp");;;LOAD LISP ASPACE DE SU DUNG HAM "alignspace" - 1 HAM CO SAN TRONG EXPRESS TOOL
;;;;;;;;;;;;;;;;;;;;;;;;;;;HAM *ERROR* NAY CO TAC DUNG KHI HUY LENH GIUA CHUNG SE VAN GIU NGUYEN CAC THAM SO OSNAP;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Olmode (getvar "OSMODE"));;;;;;LAY THONG SO OSNAP HIEN THOI, TRUOC KHI THAY DOI OSNAP
  
(setvar "CMDECHO" 0);;;;;BO HET CAC CHE DO BAT DIEM OSNAP
(setvar 'tilemode 1);;;;DUA MAN HINH VE KHONG GIAN MODEL
(setq en (entsel "\n Chon pline ")) ;;;;;CHON DOI TUONG LA PLINE
(setvar "OSMODE" 1);;;;;GAN CHO DO BAT DIEM OSNAP LA AND
(setq Chcao (abs (getdist "\nChon chieu cao khung:  ")));;;;;NHAP CHIEU CAO KHUNG
(setvar "OSMODE" 0);;;;;BO HET CAC CHE DO BAT DIEM OSNAP
(setq ob (vlax-ename->vla-object (car en)) ;;;LAY ENAME DOI TUONG PLINE
       n (vlax-curve-getEndParam ob);;;;SO DINH PLINE
       KCSX (distance (vlax-curve-getPointAtParam ob 0) (vlax-curve-getPointAtParam ob 1));;;;;TINH KHOANG CACH CHIEU NGANG CUA KHUNG
)
(setq Lts1 (list));;KHAI BAO LTS1 DANG DANH SACH
(setq Lts2 (list));;KHAI BAO LTS2 DANG DANH SACH
(setq i 0)
(while (<= i n)
	(progn
		(setq P1 (vlax-curve-getPointAtParam ob i);;;;DINH THU I CUA PLINE
		      P2 (vlax-curve-getPointAtParam ob (+ i 1));;;;DINH THU I+1 CUA PLINE
		)
	  	(setq Lts1 (list P1 P2));;;;CHO VAO 1 DANH SACH (P1 P2)
	  	(setq Lts2 (append Lts2 (list Lts1)));;;;GOP CAC DANH SACH ((P1 P2) (P3 P4).....)
	)
(setq i (+ i 2))
)
(setvar 'tilemode 0);;;;DUA MAN HINH VE KHONG GIAN LAYOUT
(setq Pnt_dat (getpoint "\nChon diem dat: "));;;;CHON DIEM DAT CHEN KHUNG
(setq j 0)
(while (< j (length Lts2))
  (progn
	(setq Pnt_i (Polar Pnt_Dat 0 (* KCSX j 1.5)));;;;DIEM DAT KHUNG THU I
  	(setq P2A (Polar Pnt_i (/ pi 2) Chcao));;;;;;;TINH DIEM TREN (TAY BAC) CUA KHUNG
  	(setq P4A (Polar Pnt_i 0 KCSX));;;;;;;TINH DIEM NGANG VOI DIEM DAT KHUNG (DONG NAM) CUA KHUNG
    	(setq Pnt1 (car (nth j Lts2))) ;;;;;;;LAY DIEM THU NHAT TRONG DANH SACH DINH PLINE
    	(setq Pnt2 (cadr (nth j Lts2))) ;;;;;;;LAY DIEM THU HAI TRONG DANH SACH DINH PLINE
    	(command "Zoom" P2A P4A);;;;ZOOM VOI CUA SO HINH CHU NHAT
  	(command "Mview" P2A P4A);;;;TAO MVIEW THEO HINH CHU NHAT (DIEM TAY BAC - DONG NAM)
  	(command "Zoom" P2A P4A);;;;ZOOM VOI CUA SO O VI TRI MVIEW VUA TAO
  	(command "MSPACE");;;;CHUI VAO TRONG KHONG GIAN MODEL O MVIEW
  	(alignspace Pnt1 Pnt2 Pnt_i P4A);;;;XOAY KHONG GIAN MODEL VUA VOI KHUNG MVIEW VUA TAO
	(command "PSPACE");;;;;;;THOAT RA KHOI KHONG GIAN MODEL, TRO VE KHONG GIAN LAYOUT
    	(command "Zoom" "E");;;;ZOOM VUA MAN HINH
  )
(setq j (+ j 1))
)
(command "UCS" "W");;;;DUA VE HE TOA DO WORLD
(command "Plan" "W");;;;DUA VE MAT PHANG WORLD
(setvar "OSMODE" Olmode);;;TRA VE CHE DO OSNAP BAN DAU
(princ)
)

Của bạn đây


<<

Filename: 315898_sxk.lsp
Tác giả: nhoclangbat
Bài viết gốc: 315899
Tên lệnh: dkk
Listp bảng tọa độ vn2000

- Mấy bạn test hộ nhoc lần cuối, nhoc đã cố gắng mò mẫn, mót nhặt, chắp vá, đông tây y kết hợp ^^ để cố gắng ko lỗi nữa :)

- nhoc đổi lại thứ tự xíu là pick tâm thửa xong mới chọn điểm bắt đầu hen, để ý ko nhầm ^^

- nếu vấn đề chọn điểm bắt đầu rùi chạy tọa độ các bạn thấy ok, nhoc sẽ xử tiếp phần style font của text ^^

>>

- Mấy bạn test hộ nhoc lần cuối, nhoc đã cố gắng mò mẫn, mót nhặt, chắp vá, đông tây y kết hợp ^^ để cố gắng ko lỗi nữa :)

- nhoc đổi lại thứ tự xíu là pick tâm thửa xong mới chọn điểm bắt đầu hen, để ý ko nhầm ^^

- nếu vấn đề chọn điểm bắt đầu rùi chạy tọa độ các bạn thấy ok, nhoc sẽ xử tiếp phần style font của text ^^

(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)
;;;;;;;;;;;============================================================
(defun Makepline (listpoint closed Layer Linetype LTScale xdata / Lst)
	(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	'(100 . "AcDbPolyline")
	(cons 90 (length listpoint))
	(cons 70 (if closed 1 0))))
	(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
	(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
	(entmakex Lst))
	;end;=================================
;;;;------------------------------------------
;;ham tao text 2
(defun mktext (point height string justify layer textstyle / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 textstyle)
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 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)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;;;;;;;;;;-------------------------------------------
(defun dieukientimdiem (Pchon lstpoint / i kq tiep toadop)

	(setq tiep T)
  	(setq i 0)
  	(while (and tiep (< i (length lstpoint)))
	  (setq toadop (nth i lstpoint))	  
	  (if (equal Pchon toadop 0.001)
	    (progn
	      (setq tiep nil)	    
	      (setq kq "1")
	      )
	    )
	  (setq i (+ i 1))
	  )
kq  
)
;==============================================---------------------
;loai bo phan tu giong nhau va bat dau bat = phantu cho truoc ( du lieu kieu point) (thuan kim dong ho)
(defun khoi (start myList / lay newList)
    
  (setq
    lay nil
    newList nil
  )
  (foreach x myList
    (if (ssGanDung x start)
      (setq lay T)
    )
    (if lay
      (setq newList (append newList (list x)))
    )
  )
  (setq lay T)
  (foreach x (cdr myList)
    (if (ssGanDung x start)
      (setq lay nil)
    )
    (if lay
      (setq newList (append newList (list x)))
    )
  )
  (setq newList (append (list (car newList)) (reverse (cdr newList))))
)
(defun ssGanDung (x y)
  (if (equal x y 0.001)
    T
    nil
  )
)
;;-----------------------------------
(defun Wdis (p1 p2 / dis ang point point1)
  (setq dis (distance p1 p2))
  (setq ang (angle p1 p2))
  (if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
    (progn
      (setq ang (+ Ang Pi)) 
      (setq Point (polar p2 ang (/ dis 2.0)))
      (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))

    )
	(progn
    (setq Point (polar p1 ang (/ dis 2.0)))
    (setq Point1 (polar point (+ (/ pi 2) ang) (* 0.25 (/ TileBdHT 500))))
	)
  )
  (command "Text" "S" "vaptimn" "c" point1 (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 2))
)
;--------------------------------------------------------------------------
(defun pointpl (name t2 k / namem i bien t1 p1 diem)
	(setq namem name)
	(setq i 1)
	(while (<= i k)
	(progn
		(setq bien (assoc t2 namem))
		(setq t1 (member bien namem))
		(setq p1 (car t1))
		(setq namem (cdr t1))
		(setq diem (cdr p1))
		(setq i (+ 1 i))
	)
	)
	diem
);;;-----------------------------------------------------------------------------
(defun Rf_slstart  (start myList / lay newList)
  (setq
    lay nil
    newList nil
  )
  (foreach x myList
    (if (equal x start 0.001)
      (setq lay T)
    )
    (if lay
      (setq newList (append newList (list x)))
    )
  )
  (setq lay T)
  (foreach x (cdr myList)
    (if (equal x start 0.001)
      (setq lay nil)
    )
    (if lay
      (setq newList (append newList (list x)))
    )
  )
  newList
)
;hàm tạo textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
(prompt "LSP XUAT BANG TOA DO CAC DINH THU DAT, LENH: DKK")
;;----------------------------------------------------------------------------------------------
(defun c:dkk (/ p tam i f k lst dk lst1 lst2 lst_new pt11 i kk m luuxy pt old  canh p01 p02 p03 p04 p05 p06 p07 p08 p09 p10 p11 p12 p13 p14 x x1 y y1 toado toado0 toado1 pyy pxx psh pgc t0 t1 t2 t3 t4 y tsh txx tyy tgc)
(setq old (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
;-----------------------------------------------------
(if (null (tblsearch "style" "vaptimn"))
		(emk_style "vaptimn" "vavon.ttf"))
	(if (null (tblsearch "style" "vhelveb"))
		(emk_style "vhelveb" "vhelven.TTF"))
	(if (null (tblsearch "layer" "sohieu_diem"))
		(_layer2 "sohieu_diem" 2))
    (if (null (tblsearch "layer" "canh"))
		(_layer2 "canh" 3))
	(if (null (tblsearch "layer" "bang_toado"))
		(_layer2 "bang_toado" 7))
	(if (null (tblsearch "layer" "Ranh_dat"))
		(_layer2 "Ranh_dat" 6))
	(if (not r1) (setq r1 500))
	(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
	(if (= TileBdHT nil)
		(setq TileBdHT r1))
;--------------------------------------------------------------------------
(setvar "osmode" 0)
(setq p (getpoint "\npick tam thua:"))
(command "-Boundary" p "")
(setq tam (entget (entlast)))
(setq kk (cdr (assoc 90 tam)))
(setq lst (acet-geom-vertex-list (cdr (assoc -1 tam))))
(setvar "osmode" 33)
(setq pt11 (getpoint "\nchon diem bat dau:"))
(setq dk (dieukientimdiem pt11 lst))
(if (and (/= dk nil) (eq dk "1"))
;------------------------------------------==========================================---------------------------------
(progn
;;====================-----------------------------======================================-----------------------
(if lst
(progn
;------------------------===============================--------------------------------------
(setq bit (cond (bit) ("T")))
(initget "T N")
(setq	Tmp (strcat "\nBan muon chay Thuan hay Ngich chieu dong ho  <" bit ">: ")
	    bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "T")
(setq lst_new (khoi pt11 lst))
(setq lst_new (Rf_slstart pt11 lst))
)
;---------------------------------==============================-----------------------------------
(Makepline lst_new 1 "Ranh_dat" nil nil nil)
;----------------------------=========================================--------------------------
)
)
;--------------------------------------------------------------------------------------------------------
(setq luuxy (entget (entlast)))
(setvar "osmode" 0)
	(setq pt (getpoint "\n Diem dat bang toa do :"))
	(setq k (cdr (assoc 90 luuxy)))
	(if (/= pt nil)
		(progn
			(setq p01 pt)
			(setq p02 (mapcar '+ pt '(10.0  0.0 0.0)))
			(setq p03 (mapcar '+ pt '(22.5 -2.5 0.0)))
			(setq p04 (mapcar '+ pt '(35.0  0.0 0.0)))
			(setq p05 (mapcar '+ pt '(45.0  0.0 0.0)))
			(setq p06 (mapcar '+ pt '(0.0 -5.0 0.0)))
			(setq p07 (mapcar '+ pt '(10.0 -2.5 0.0)))
			(setq p08 (mapcar '+ pt '(35.0 -2.5 0.0)))
			(setq p09 (mapcar '+ pt '(45.0 -5.0 0.0)))
			(if (<= k 10)			
				(progn
					(setq p10 (mapcar '+ pt '(0.0 -40.0 0.0)))
					(setq p11 (mapcar '+ pt '(10.0 -40.0 0.0)))
					(setq p12 (mapcar '+ pt '(22.5 -40.0 0.0)))
					(setq p13 (mapcar '+ pt '(35.0 -40.0 0.0)))
					(setq p14 (mapcar '+ pt '(45.0 -40.0 0.0)))
				)
				(progn
					(setq ty (* -1 (+ 10.0 (* k 3))))
					(setq t0 (list 0.0 ty 0.0))
					(setq t1 (list 10.0 ty 0.0))
					(setq t2 (list 22.5 ty 0.0))
					(setq t3 (list 35.0 ty 0.0))
					(setq t4 (list 45.0 ty 0.0))
					(setq p10 (mapcar '+ pt t0))
					(setq p11 (mapcar '+ pt t1))
					(setq p12 (mapcar '+ pt t2))
					(setq p13 (mapcar '+ pt t3))
					(setq p14 (mapcar '+ pt t4))
				)
			)
			
			(makeline p01 p05 "bang_toado" nil nil nil)
			(makeline p01 p10 "bang_toado" nil nil nil)
			(makeline p02 p11 "bang_toado" nil nil nil)
			(makeline p03 p12 "bang_toado" nil nil nil)
			(makeline p04 p13 "bang_toado" nil nil nil)
			(makeline p05 p14 "bang_toado" nil nil nil)
			(makeline p07 p08 "bang_toado" nil nil nil)
			(makeline p06 p09 "bang_toado" nil nil nil)
			(makeline p10 p14 "bang_toado" nil nil nil)
;------------------------------------------------------------------------------------------------------------------
(mktext (mapcar '+ pt '(22.5 2.0 0.0)) 1.25 "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -1.5 0.0)) 1.15 "Soá hieäu" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(5.0 -3.5 0.0)) 1.15 "ñieåm" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(22.5 -1.25 0.0)) 1.15 "Toïa ñoä" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(16.25 -3.75 0.0)) 1.15 "X(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(28.75 -3.75 0.0)) 1.25 "Y(m)" "M" "bang_toado" "vhelveb")
(mktext (mapcar '+ pt '(40.0 -2.5 0.0)) 1.25 "Caïnh" "M" "bang_toado" "vhelveb")
;-------------------====================--------------------------------------------------------------------------
		)
	)
	(setq i 1)
	(while (<= i k)
		(progn
			(setq toado (pointpl luuxy 10 i))
			(setq x (rtos (car toado) 2 2))
			(setq y (rtos (cadr toado) 2 2))
			(setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
			(mktext (mapcar '+ toado doi) (/ TileBdHT 500) (itoa i) "L" "sohieu_diem" "vaptimn")
            (command "-layer" "s" "sohieu_diem" "")			
			(command ".donut" 0 (* 0.25 (/ TileBdHT 500)) toado "")			
			(setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
			(if (= i 1)
				(progn
					(setq toado1 toado)
					(setq x1 (rtos (car toado1) 2 2))
					(setq y1 (rtos (cadr toado1) 2 2))
				)
			)
			(if (>= i 2)
(progn
	(setq canh (distance toado0 toado))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(setvar "clayer" "canh")
	(wdis toado0 toado)
)
			)
			(mktext psh 1.2 (itoa i) "M" "bang_toado" "vaptimn")
			(mktext pxx 1.2 y "M" "bang_toado" "vaptimn")
			(mktext pyy 1.2 x "M" "bang_toado" "vaptimn")
			
			(setq toado0 toado)
			(setq i (+ i 1))
		)
	)
	(setvar "clayer" "canh")
	(wdis toado toado1)
	(setq canh (distance toado toado1))
			(setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
			(setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
			(setq psh (mapcar '+ pt tsh))
			(setq pxx (mapcar '+ pt txx))
			(setq pyy (mapcar '+ pt tyy))
			(setq pgc (mapcar '+ pt tgc))
	(mktext pgc 1.2 (rtos canh 2 2) "M" "bang_toado" "vaptimn")
	(mktext psh 1.2 "1" "M" "bang_toado" "vaptimn")
	(mktext pxx 1.2 y1 "M" "bang_toado" "vaptimn")
	(mktext pyy 1.2 x1 "M" "bang_toado" "vaptimn")
	
);end progn
(alert "ban chua chon dung dinh thua dat\nban chay lai lenh tu dau hen thong cam ^^!!")
); end if
    (entdel (cdr (assoc -1 tam)))
	(setvar "clayer" "0")
	(setvar "osmode" old)
    (setvar "cmdecho" 1)
	(princ "\n")
	(princ)
)

P/s: thanks các anh đã nhiệt tình giúp đở nhoc ^^, giờ đi ăn cơm cái đói rùi ^^


<<

Filename: 315899_dkk.lsp
Tác giả: thanhduan2407
Bài viết gốc: 315889
Tên lệnh: dpl
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
(vl-load-com)
(defun c:DPL ();;;DINH POLYLINE
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 1)
(setq loop T)
(setq ObjPline (car (entsel "\nChon Polyline: ")))
(while loop
	(setq Pnt (getpoint "\nPick diem de biet dinh gan nhat la dinh thu may cua Polyline: "))
  	(cond
	 ...
>>
(vl-load-com)
(defun c:DPL ();;;DINH POLYLINE
(defun *error* ( msg )
(if Olmode (setvar 'osmode Olmode))
(if (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg))
)
(princ)
)
(setq Olmode (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 1)
(setq loop T)
(setq ObjPline (car (entsel "\nChon Polyline: ")))
(while loop
	(setq Pnt (getpoint "\nPick diem de biet dinh gan nhat la dinh thu may cua Polyline: "))
  	(cond
	  (T
		(if Pnt
		  (progn
			(setq PVG (vlax-curve-getClosestPointTo ObjPline Pnt)
			          Pd1 (vlax-curve-getpointAtParam ObjPline (fix (vlax-curve-getparamatPoint ObjPline PVG T)))
			          Pd2 (vlax-curve-getpointAtParam ObjPline (1+ (fix (vlax-curve-getparamatPoint ObjPline PVG T))))
			)
			(setq D1 (distance PVG Pd1))
			(setq D2 (distance PVG Pd2))
			(if (>= D1 D2)
			    (setq Dinh (fix (vlax-curve-getparamatPoint ObjPline PVG)))
			    (setq Dinh (1+ (fix (vlax-curve-getparamatPoint ObjPline PVG))))
			)
			(Alert (strcat  "\nDinh ban vua pick la dinh thu : " (rtos Dinh 2 0) " cua Polyline"))
		  )
		  (setq loop nil)
		)
	  )
	)
)  
(setvar "OSMODE" Olmode)
(princ)
)

<<

Filename: 315889_dpl.lsp
Tác giả: hiepttr
Bài viết gốc: 313842
Tên lệnh: circlebox grc cb2 grc2
Chương 10.3 : Grdraw, Grvecs, Grtext

@ Ket: cái mapcar cập kê khá độc ^^

Đã sửa theo sự chỉ điểm

Chờ bài mới ! :D :D :D

;Bai tap chuong 10.3_sua
;;Bai 1:
(defun c:CIRCLEBOX( / ss info cen r xc yc Rve BL BR TL TR)
(prompt "\nChon duong tron: ")
(setq ss (ssget '((0 . "CIRCLE"))))
(if ss
	(progn
		(setq ss (ss2lst ss))
		(or #offset (setq #offset 0.0))
		(setq #offset 
			(cond
				((getreal (strcat "\nKhoang offset <" (rtos #offset)...
>>

@ Ket: cái mapcar cập kê khá độc ^^

Đã sửa theo sự chỉ điểm

Chờ bài mới ! :D :D :D

;Bai tap chuong 10.3_sua
;;Bai 1:
(defun c:CIRCLEBOX( / ss info cen r xc yc Rve BL BR TL TR)
(prompt "\nChon duong tron: ")
(setq ss (ssget '((0 . "CIRCLE"))))
(if ss
	(progn
		(setq ss (ss2lst ss))
		(or #offset (setq #offset 0.0))
		(setq #offset 
			(cond
				((getreal (strcat "\nKhoang offset <" (rtos #offset) ">:")))
				(#offset)
			)
		)
		(or #col (setq #col 1))
		(setq #col 
			(cond
				((getint (strcat "\nMau bounding box <" (itoa #col) ">:")))
				(#col)
			)
		)
		(foreach cir ss
			(setq info (entget cir)
				  cen (cdr (assoc 10 info))
				  r (cdr (assoc 40 info))
				  xc (car cen)
				  yc (cadr cen)
				  Rve (+ r #offset)
				  BL (trans (list (- xc Rve) (- yc Rve)) 0 1)
				  BR (trans (list (+ xc Rve) (- yc Rve)) 0 1)
				  TL (trans (list (- xc Rve) (+ yc Rve)) 0 1)
				  TR (trans (list (+ xc Rve) (+ yc Rve)) 0 1)
			)
			(grdraw BL BR #col 1)
			(grdraw BL TL #col 1)
			(grdraw TR TL #col 1)
			(grdraw TR BR #col 1)
		)	;for
	)
)
(princ)
)
;==========================================================================================
;;Bai 2:
(defun c:GRC( / cen r i pt lst_pt pt1 pt2)
(setq
	cen (getpoint "\nChon tam: ")
	r (getdist cen "\nNhap ban kinh: ")
	)
(if (and cen r)
	(progn
		(setq lst_pt (CIR_POL cen r 360)
			  i 0)
		(repeat 360
			(setq pt1 (nth i lst_pt)
				  pt2 (nth (setq i (1+ i)) lst_pt)
			)
			(grdraw pt1 pt2 200 1)
		)
		(princ)
	)
)
)
;==============================================================================================
;;Bai 3:
;3_1:
(defun c:CB2( / ss info cen r xc yc Rve BL BR TL TR)
(prompt "\nChon duong tron: ")
(setq ss (ssget '((0 . "CIRCLE"))))
(if ss
	(progn
		(setq ss (ss2lst ss))
		(or #offset (setq #offset 0.0))
		(setq #offset 
			(cond
				((getreal (strcat "\nKhoang offset <" (rtos #offset) ">:")))
				(#offset)
			)
		)
		(or #col (setq #col 2))
		(setq #col 
			(cond
				((getint (strcat "\nMau bounding box <" (itoa #col) ">:")))
				(#col)
			)
		)
		(foreach cir ss
			(setq info (entget cir)
				  cen (cdr (assoc 10 info))
				  r (cdr (assoc 40 info))
				  xc (car cen)
				  yc (cadr cen)
				  Rve (+ r #offset)
				  BL (trans (list (- xc Rve) (- yc Rve)) 0 1)
				  BR (trans (list (+ xc Rve) (- yc Rve)) 0 1)
				  TL (trans (list (- xc Rve) (+ yc Rve)) 0 1)
				  TR (trans (list (+ xc Rve) (+ yc Rve)) 0 1)
			)
			(grvecs (list #col BL BR BR TR TR TL TL BL))
		)	;for
	)
)
(princ)
)
;==============================
;3_2:
(defun c:GRC2( / cen r lst_pt lst)
(setq
	cen (getpoint "\nChon tam: ")
	r (getdist cen "\nNhap ban kinh: ")
	)
(if (and cen r)
	(progn
		(setq lst_pt (CIR_POL cen r 360)
			  lst (apply 'append (mapcar 'list lst_pt (cdr lst_pt))))
		(grvecs (cons 3 lst))
		(princ)
	)
)
)
;=========================================================================================================
;;Bai 4:
(grtext -1 (strcat "Hello " (getvar 'loginname) " !"))
;***********************************************************************************************************************
;====================<>-------------------------------------------<>====================================================
;***********************************************************************************************************************
(defun ss2lst (ss / ename i lst)
;chuyen ss thanh list
(setq i 0)
(repeat (sslength ss)
	(setq ename (ssname ss i)
		  i (1+ i)
		  lst (cons ename lst))
)
(reverse lst)
)
;======================================
(defun cir_pol(cen r n / i ang pt lst_pt)
;ham tra ve list toa do dinh polygon n canh gia lap duong tron tam cen, ban kinh r
;diem cuoi trung diem dau
(setq i -1)
(repeat (1+ n)
	(setq ang (* (setq i (1+ i)) 2 (/ pi n))
		  pt (polar cen ang r)
		  lst_pt (cons pt lst_pt))
)
(reverse lst_pt)
)

<<

Filename: 313842_circlebox_grc_cb2_grc2.lsp
Tác giả: Tot77
Bài viết gốc: 315996
Tên lệnh: gkt
Xin nhờ các cao thủ lisp do kích thước bao, xuất ra text...

Bạn thử cái này. Có thêm yêu cầu là cái text nên nổ thành text chứ đừng để mtext, và phải nằm bên trong tấm.

Gõ lệnh rồi quét hết các pline.

(vl-load-com)
(defun c:gkt (/ minp maxp txt cao pt pt1 pt2 h w get)
  (defun midp (d1 d2) (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
  (defun dxf(id v) (cdr (assoc id (entget v))))
  (defun getkt (lst)
    (defun near (l ham dau) (car...
>>

Bạn thử cái này. Có thêm yêu cầu là cái text nên nổ thành text chứ đừng để mtext, và phải nằm bên trong tấm.

Gõ lệnh rồi quét hết các pline.

(vl-load-com)
(defun c:gkt (/ minp maxp txt cao pt pt1 pt2 h w get)
  (defun midp (d1 d2) (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
  (defun dxf(id v) (cdr (assoc id (entget v))))
  (defun getkt (lst)
    (defun near (l ham dau) (car (vl-sort l '(lambda (x y) (dau (ham x) (ham y))))))
    (list (near (vl-remove-if-not '(lambda (x) (equal (car x) (apply 'min (mapcar 'car lst)))) lst) cadr >)
 (near (vl-remove-if-not '(lambda (x) (equal (car x) (apply 'max (mapcar 'car lst)))) lst) cadr >) 
 (near (vl-remove-if-not '(lambda (x) (equal (cadr x) (apply 'min (mapcar 'cadr lst)))) lst) car >)
 (near (vl-remove-if-not '(lambda (x) (equal (cadr x) (apply 'max (mapcar 'cadr lst)))) lst) car >)
    )
  )
  
  (setq os (getvar 'osmode)) (setvar 'osmode 0)
  (foreach v (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE"))))))
    (vla-getBoundingBox (vlax-ename->vla-object v) 'minp 'maxp)
    (setq minp (vlax-safearray->list minp)
 maxp (vlax-safearray->list maxp))
    (if (setq txt (ssget "C" minp maxp '((0 . "*TEXT"))))
      (progn
(setq cao (* 2 (cdr (assoc 40 (entget (setq txt (ssname txt 0))))))
     pt (polar (midp minp (list (car maxp) (cadr minp))) (* 0.5 pi) (- cao))
     pt1 (polar (midp maxp (list (car minp) (cadr maxp))) (* 0.5 pi) cao)
     pt2 (polar (midp maxp (list (car maxp) (cadr minp))) 0 cao)
     h  (abs (- (cadr maxp) (cadr minp))) 
     w  (abs (- (car maxp) (car minp)))       
     get (getkt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget v))))
)
(command "dimlinear" (car get) (cadr get) pt1)
(command "dimlinear" (nth 2 get) (last get) pt2)
(entmake (list '(0 . "TEXT") (cons 10 pt)  (cons 11 pt) (cons 71 0) (cons 40 (* 0.5 cao)) (cons 73 3) (cons 72 1)
      (cons 1 (strcat (dxf 1 txt) "x" (rtos (min h w) 2 0) "x" (rtos (max h w) 2 0)))))
    ))
  )
  (setvar 'osmode os) (princ) 
)
 

<<

Filename: 315996_gkt.lsp
Tác giả: kaka912511
Bài viết gốc: 316024
Tên lệnh: bt2-1 bt2-2
Chữa bài tập chương 2

A ơi ! em gửi bài tập chương 2.

;BT1
(defun c:BT2-1( / x y z e)
  (setq x (+ 2 7))
  (setq y (- 3 1.25))
  (setq z 5.0 )
  (setq e (+ z (* 0.4 (- x y ))))
  (setq kq (+ x y z e ))
  )
;BT2
(defun c:BT2-2 (/ a b c d )
  (setq kq nil)
  (setq c ( / (* (setq a 2000 ) (setq b 1000) ) 2.0 ) )
  ;trung binh cong 3 so
  (defun trungbinhcong ( a b c )
    (/ (+ a b c ) 3.0 ) )
  
  ; ham tinh dien tich
  (defun dientich ( a b )
    (/ (* a b ) 2.0 ))
 ...
>>

A ơi ! em gửi bài tập chương 2.

;BT1
(defun c:BT2-1( / x y z e)
  (setq x (+ 2 7))
  (setq y (- 3 1.25))
  (setq z 5.0 )
  (setq e (+ z (* 0.4 (- x y ))))
  (setq kq (+ x y z e ))
  )
;BT2
(defun c:BT2-2 (/ a b c d )
  (setq kq nil)
  (setq c ( / (* (setq a 2000 ) (setq b 1000) ) 2.0 ) )
  ;trung binh cong 3 so
  (defun trungbinhcong ( a b c )
    (/ (+ a b c ) 3.0 ) )
  
  ; ham tinh dien tich
  (defun dientich ( a b )
    (/ (* a b ) 2.0 ))
  ;ham tinh tich 4 so
  (defun tich ( a b c d )
    ( * a b c d ))
  ;ham tinh lap phuong 1 so
  (defun lapphuong ( a )
    ( * a a a )))
;cau3 vi cac so nhap vao deu la kieu nguyen , vi vay (a+b)/2 la 1 so nguyen ,
;neu tong 2 so khong chia het cho 2 thi ketqua se sai.

http://www.cadviet.com/upfiles/3/129539_tmp_1.lsp


<<

Filename: 316024_bt2-1_bt2-2.lsp

Trang 175/330

175