Viết lisp theo yêu cầu [phần 2]

[lephilong_gtvttp 0]

Chào mọi người, mình mới làm quen với Cad, nên còn non lắm ! Mong mọi người giúp mình với! Mình muốn chia một đối tượng thành nhiều đối tượng tại các điểm giao nhau, nhưng tìm mãi mà chưa được ! Mình cũng mới tham gia diễn đàn này, nên cũng chưa đọc hết được tất cả nội dung !

[hungvq 0]

Chào cả nhà! Các bác, các bạn các anh chị e giúp mình với.

Mình muốn xin cái lip tính diện tích nhiều hình cùng 1 lúc. Chả là mình đang làm công tác đền bù, phải nhặt ra nhà nào là nhà G1, G2... rồi tính diện tích cho từng loại để ước tính chi phí đền bù. Công việc nhặt ra loại nhà nào thì đã có lệnh "fi" để lọc rồi, còn phần tính diện tích mình đang làm thủ công là:

- "Bo" các nhà lại (ví dụ: 100 nhà thì phải làm 100 lệnh "bo")

- Sau khi "bo" tính diện tích của các nhà đó.

- Ngồi mổ cò các diện tích vào cell để tính tổng diện tích các nhà.

Ôi. mình đang hoa hêt cả mắt vì không chỉ có 1 loại nhà G1 đâu, còn G2, G3, B1, B2 .... mỗi loại lại mấy trăm nhà. Nếu mình làm như thế này thì tèo mất.

Mình cũng đã tìm hiểu qua mấy lip (của bác Duy782006; Duyanhhcm; Duyvan83...) nhưng chưa dùng được lip nào cả (hay là chưa biết cách dùng?)

Mong các tiền bối chỉ giáo giúp với!

[phamngoctukts 714]

thanks bác ketxu nhiu ...nhưng e muốn dùng hatch qua lisp như sau:

;;; =========================== HATCH =================================

HATCH

(defun c:H0 () (command "Bhatch" "P" "pattern" "solid"))

(defun c:Ht () (command "Bhatch" "P" "pattern" "ANSI31" "300" ""))

(defun c:Hb () (command "Bhatch" "P" "pattern" "dang-01" "30" ""))

sau khi đánh lệnh hatch tường ht thì hatch sẽ tự động chuyển về layer 00-09hatch...mong bác sửa giùm e với ...Và cái lisp chuyển về layer dim hình như hok dùng dc bác ơi...e đánh lệnh d thi no chẳng hiện ra cái chi chi :).

Bạn thêm dòng này vào trong mỗi câu lệnh (command "change" "L" "" "P" "LA" "00-09hatch" "")

Ví dụ (defun c:Ht () (command "Bhatch" "P" "pattern" "ANSI31" "300" ""))

-> (defun c:Ht () (command "Bhatch" "P" "pattern" "ANSI31" "300" "") (command "change" "L" "" "P" "LA" "00-09hatch" ""))

trong đó layer 00-09hatch bạn thay bằng layer nào mà bạn muốn và layer đó phải có trong bản vẽ rồi.

[ketxu 2.983]

thanks bác ketxu nhiu ...nhưng e muốn dùng hatch qua lisp như sau:

;;; =========================== HATCH =================================

HATCH

(defun c:H0 () (command "Bhatch" "P" "pattern" "solid"))

(defun c:Ht () (command "Bhatch" "P" "pattern" "ANSI31" "300" ""))

(defun c:Hb () (command "Bhatch" "P" "pattern" "dang-01" "30" ""))

sau khi đánh lệnh hatch tường ht thì hatch sẽ tự động chuyển về layer 00-09hatch...mong bác sửa giùm e với ...Và cái lisp chuyển về layer dim hình như hok dùng dc bác ơi...e đánh lệnh d thi no chẳng hiện ra cái chi chi :).

Phần Hatch thì Bác Tú đã hướng dẫn bên dưới rồi, bạn làm theo nhé.Còn phần dim srr vì thiếu dấu ngoặc, mình đã edit lại trực tiếp trên bài cũ r, bạn lấy lại nhé

 

Chào mọi người, mình mới làm quen với Cad, nên còn non lắm ! Mong mọi người giúp mình với! Mình muốn chia một đối tượng thành nhiều đối tượng tại các điểm giao nhau, nhưng tìm mãi mà chưa được ! Mình cũng mới tham gia diễn đàn này, nên cũng chưa đọc hết được tất cả nội dung !

Đối tượng của bạn là j ???Trên diễn đàn có lisp Break All anh gia_bach đã giới thiệu đó, bạn search thử xem có phù hợp với yêu cầu không

 

Chào cả nhà! Các bác, các bạn các anh chị e giúp mình với.

Mình muốn xin cái lip tính diện tích nhiều hình cùng 1 lúc. Chả là mình đang làm công tác đền bù, phải nhặt ra nhà nào là nhà G1, G2... rồi tính diện tích cho từng loại để ước tính chi phí đền bù. Công việc nhặt ra loại nhà nào thì đã có lệnh "fi" để lọc rồi, còn phần tính diện tích mình đang làm thủ công là:

- "Bo" các nhà lại (ví dụ: 100 nhà thì phải làm 100 lệnh "bo")

- Sau khi "bo" tính diện tích của các nhà đó.

- Ngồi mổ cò các diện tích vào cell để tính tổng diện tích các nhà.

Ôi. mình đang hoa hêt cả mắt vì không chỉ có 1 loại nhà G1 đâu, còn G2, G3, B1, B2 .... mỗi loại lại mấy trăm nhà. Nếu mình làm như thế này thì tèo mất.

Mình cũng đã tìm hiểu qua mấy lip (của bác Duy782006; Duyanhhcm; Duyvan83...) nhưng chưa dùng được lip nào cả (hay là chưa biết cách dùng?)

Mong các tiền bối chỉ giáo giúp với!

Mình vẫn dùng có thấy sao đâu nhỉ ^^ Đoạn lisp này của bác nào vào confirm lại giúp e với.Ngày xưa cứ cặm cụi down,giờ hok nhớ của ai để hỏi nữa :) E Dùng Cad08 thì không còn phần định chiều cao text trong lệnh text nữa, mà nó đi kèm theo Style, nên phải sửa lại trong các hàm tạo text bằng command ^^ Có lẽ nên chuyển sang entmake thì hay hơn :) Nhưng tạm thời cứ chữa cháy để bạn ấy dùng đã

;; free lisp from cadviet.com
;; free lisp from cadviet.com

;Tinh Dt co mien khoe rong ben trong va lap bang
(defun c:dt2()
(setvar "cmdecho" 0)
(command "undo" "begin")
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode"))  
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nty le ban ve : 1/"))
   caot1 (getreal (strcat "\nCao text : ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))
(setq k 0 tdt 0)

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq     P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
       "pline" P1 P4 ""
       "text" "m" P6 (* 1.2 h) 0 "Bang Thong Ke DT"
       "text" "m" P7 h 0 "STT"
       "text" "m" P8 h 0 "Dien tich (m2)"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(command "erase" ss "")
(setq k (+ 1 k))
(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(setq PT (list (car P3) (cadr P3))
   P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
   P9 (list (car PT) (- (cadr P3)(* 3 h)))
   P10 (list (car P1) (cadr P9))
   P11 (list (car P2) (cadr P9))
   P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
   P13 (list (car P8) (cadr P12))
   );setq
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command "cecolor"4 "-boundary" pt1 "");; boundary
(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary
(setq cur frome	ss (ssadd) S 0)
(while 	(not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq cur (entnext cur) ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq dt (getvar "area") S (+ S dt))
);while
(command "area" "A" "O" "L" "" "")
(setq dt (getvar "area"))
(setq S (* (+ S (* dt 2)) tl (/ tl 500 500)) tdt (+ s tdt))
(setvar "CEColor" lacol)
(command "pline" PT P2 P5 P3 "C"
 "pline" P1 P4 ""
 "text" "m" P7 h 0 (rtos k 2 0)
 "text" "m" P8 h 0 (rtos s 2 2))
(setq pt1 (getpoint (strcat "\nTong dien tich = " (rtos tdt 2 3) "m2. chon mien do tiep theo...")))
);while
(command "erase" ss "")
(setq ss nil)
(setvar "DIMZIN" ladin)
(command     "pline" P3 P9 P11 P5 "C"
       "pline" P10 P4 ""
       "text" "m" P12 h 0 "Tong"
       "text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(command "undo" "end")
(setvar "cmdecho" 1)
)

[truongthanh 7]

Chào bạn Truongthanh,

Hề hề hề,

Của bạn đây, hy vọng lần này bạn sẽ hài lòng.

;tinh cao do cong
(defun C:cdc (/ s1 L1 i1 txt i n k m t1 t2 t3 m1 s2 p2 p3 p4 p5 p6 )
   ;;;;;(setq s1 (getreal "\nCAO DO DAY CONG DIEM DAU: "))
   ;;;;;(setq L1 (getreal "\nCHIEU DAI CONG: "))
   ;;;;;(setq i1 (getreal "\nDO DOC CONG: "))
   (setq s1 (atof (cdr (assoc 1 (entget (car (entsel "\n Chon text cao do day cong diem dau")))))))
   (setq txt (cdr (assoc 1 (entget (car (entsel "\n Chon text chuan " )))))
       i 1
      n (strlen txt)
      k nil
   ) 
   (while (<= i n)
        (setq kt (substr txt i 1))
        (if (= kt "-")
            (progn
                    (setq k i
                            i n)
            )
         )
         (setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
       t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
       i 1
       m nil
)
(while (<= i n)
        (setq kt (substr t2 i 1))
        (if (= kt "-")
            (progn
                    (setq m i
                            i n)
            )
         )
         (setq i (1+ i))
)
(if m
  (progn   
  (setq t3 (substr t2 (+ m 3) n))
  (setq t2 (substr t2 1 (- m 2)))
  )
)
)
)
   (setq L1 (atof t2)
           i1 ( / (atof t3) 1000)
   )
   (setq m1 (getreal "\nNHAP CAO DO THIET KE DIEM: "))
   (setq s2 (- s1 (* L1 i1)))
   (setq p2 (getpoint "\nchon diem cuoi doan cong"))
   (setq p3 (getpoint "\nchon diem dat text"))
   (if (>= (car p3) (car p2))
       (progn
       (setq p4 (polar p3 (/ pi 4) 1))
   (setq p5 (polar p3 0 6))
   (setq p6 (polar p3 (/ (- 0 pi) 4) 1))
       (setvar "snapmode" 0)
   (setvar "osmode" 0)
               (command ".text" p4 "" 0 (strcat (RTOS S2 2 2))
	         ".text" "j" "tl" p6 "" "" (strcat (RTOS m1 2 2))
      		   	 ".pline" p2 "w" 0.1 0.1 p3 p5 "" )
        )
       (progn
       (setq p4 (polar p3 (* (/ pi 4) 3) 1))
   (setq p5 (polar p3 pi 6))
   (setq p6 (polar p3 (* (/ (- 0 pi) 4) 3) 1))
       (setvar "snapmode" 0)
   (setvar "osmode" 0)
               (command ".text" "j" "r" p4 "" 0 (strcat (RTOS S2 2 2))
	         ".text" "j" "tr" p6 "" "" (strcat (RTOS m1 2 2))
      		   	 ".pline" p2 "w" 0.1 0.1 p3 p5 "" )
       )
    )

   (setvar "snapmode" 0)
   (setvar "osmode" 16383)

(princ)
)

Hề hề hề,...

Anh Bình ởi! Nhờ anh sửa cái này dùm em lại 1 chút! Cái chỗ "NHAP CAO DO THIET KE DIEM:" nhờ anh sửa lại là "CHON CAO DO THIET KE DIEM" dùm em lun anh!Em đã có sẵn text trên màn hình rồi!Thanks anh nhiều!Làm phiền anh tí nữa nhé! Chứ cài này em xài OK rùi!

[truongthanh 7]

Nhờ anh em sửa dùm em cái LISP tra cứu tọa độ điểm này dùm em với:

1/ Em kéo qua bên trái thì chữ nhảy qua bên phải, pline kẻ ngang phân cách X và Y lại nhảy qua bên trái.

2/ Pline kẻ ngang phân cách X và Y ngắn, trong khi X và Y thì dài quá, giờ làm sao X và y dài bao nhiêu thì Pline kẻ dài bấy nhiu.

3/ Sau khi lisp thực hiện xong trả lại bắt điem như ban đầu mình đang mặc định trong CAD (hiện nay là thực hiện xong nó tắt bắt đểm hết)

4/Và sao lisp thực hiện được mà trên dòng command vẫn hiện chữ "Unknown command "TCD"

Xin chân thành cảm ơn anh em.

Em gửi link nhờ anh em giúp dùm.

http://www.cadviet.com/upfiles/3/tra_cuu_toa_do_diem.lsp

[phamngoctukts 714]

Mình vẫn dùng có thấy sao đâu nhỉ ^^ Đoạn lisp này của bác nào vào confirm lại giúp e với.Ngày xưa cứ cặm cụi down,giờ hok nhớ của ai để hỏi nữa :) E Dùng Cad08 thì không còn phần định chiều cao text trong lệnh text nữa, mà nó đi kèm theo Style, nên phải sửa lại trong các hàm tạo text bằng command ^^ Có lẽ nên chuyển sang entmake thì hay hơn :) Nhưng tạm thời cứ chữa cháy để bạn ấy dùng đã

Cái này ngày trước anh cũng bị mắc một vài lần rồi nên có kinh nghiệm chút.

Khi style của text đã có chiều cao rồi thì khi dùng command text không nhập được chiều cao chữ. Còn khi style của text có chiều cao = 0 thì khi dùng command text có thêm dòng nhập chiều cao chữ.

[shitty 3]

Bạn thêm dòng này vào trong mỗi câu lệnh (command "change" "L" "" "P" "LA" "00-09hatch" "")

Ví dụ (defun c:Ht () (command "Bhatch" "P" "pattern" "ANSI31" "300" ""))

-> (defun c:Ht () (command "Bhatch" "P" "pattern" "ANSI31" "300" "") (command "change" "L" "" "P" "LA" "00-09hatch" ""))

trong đó layer 00-09hatch bạn thay bằng layer nào mà bạn muốn và layer đó phải có trong bản vẽ rồi.

 

lisp hatch bác Tú sửa giúp e hok dùng dc roi,hatch vẫn để ở layer hiện hành.ko phai layer 00-09hatch...mong bác sửa giúp e với..cảm ơn bác trước :X

[phamngoctukts 714]

lisp hatch bác Tú sửa giúp e hok dùng dc roi,hatch vẫn để ở layer hiện hành.ko phai layer 00-09hatch...mong bác sửa giúp e với..cảm ơn bác trước :X

Xin lỗi bạn dùng lại dòng này:

(defun c:Ht () (command "Bhatch" "P" "pattern" "ANSI31" "300" "" pause "" "change" "L" "" "P" "LA" "00-09hatch" ""))

[ketxu 2.983]

lisp hatch bác Tú sửa giúp e hok dùng dc roi,hatch vẫn để ở layer hiện hành.ko phai layer 00-09hatch...mong bác sửa giúp e với..cảm ơn bác trước :X

Do lệnh hatch trong lisp ban đầu của bạn còn thiếu thông số chọn điểm trong vùng Hatch đó mà

Bạn sửa thành như thế này nhé :

(defun c:Ht ()
(command "-Bhatch" "P" "ANSI31" "300" "")
(while ((vl-cmdf "change" "L" "" "P" "LA" "00-09hatch" "")
)

 

Góp ý với bạn : ngoài tiếng tks kèm theo lời yêu cầu,bạn có thể dùng nút thanks để động viên hoặc để báo cho người giúp bạn biết là bạn đã ngó qua cái phần người ta đáp ứng nhu cầu của bạn.:")

[phamngoctukts 714]

Do lệnh hatch trong lisp ban đầu của bạn còn thiếu thông số chọn điểm trong vùng Hatch đó mà

Bạn sửa thành như thế này nhé :

(defun c:Ht ()
(command "-Bhatch" "P" "ANSI31" "300" "")
(while (< 0 (getvar "CMDACTIVE"))	(command pause));end while
(vl-cmdf "change" "L" "" "P" "LA" "00-09hatch" "")
)

 

Góp ý với bạn : ngoài tiếng tks kèm theo lời yêu cầu,bạn có thể dùng nút thanks để động viên hoặc để báo cho người giúp bạn biết là bạn đã ngó qua cái phần người ta đáp ứng nhu cầu của bạn.:")

nhanh tay quá vừa đang dịnh sửa lại dịnh post thì tháy cái giống y chang của mình. Đúng là hậu sinh khả uý.

[ketxu 2.983]

Hề hề, e để màn hình reply rồi ngồi type code (copy paste thì đúng hơn ^^),xong post lên thì bác cũng đã giả nhời tự bao giờ..Cái này gọi là tư tưởng nhớn gặp nhau ^^

[truongthanh 7]

Nhờ anh em sửa dùm em cái LISP tra cứu tọa độ điểm này dùm em với:

1/ Em kéo qua bên trái thì chữ nhảy qua bên phải, pline kẻ ngang phân cách X và Y lại nhảy qua bên trái.

2/ Pline kẻ ngang phân cách X và Y ngắn, trong khi X và Y thì dài quá, giờ làm sao X và y dài bao nhiêu thì Pline kẻ dài bấy nhiu.

3/ Sau khi lisp thực hiện xong trả lại bắt điem như ban đầu mình đang mặc định trong CAD (hiện nay là thực hiện xong nó tắt bắt đểm hết)

4/Và sao lisp thực hiện được mà trên dòng command vẫn hiện chữ "Unknown command "TCD"

Xin chân thành cảm ơn anh em.

Em gửi link nhờ anh em giúp dùm.

http://www.cadviet.com/upfiles/3/tra_cuu_toa_do_diem.lsp

Nhờ anh em giúp dùm mình với!

[ketxu 2.983]

Nhờ anh em giúp dùm mình với!

Vì trong lisp này của bạn phần vẽ Pline chẳng liên quan gì đến phần vết text cả, vì thế mới có chuyện nó hỏi điểm cuối để chọn làm điểm cuối Pline, còn vẽ text thì lại theo điểm đặt text, Bạn có thể làm 1 file cad vẽ rõ mục đích của bạn không? Nó có giống như 1 leader ghi chú tọa độ k ??

[truongthanh 7]

Vì trong lisp này của bạn phần vẽ Pline chẳng liên quan gì đến phần vết text cả, vì thế mới có chuyện nó hỏi điểm cuối để chọn làm điểm cuối Pline, còn vẽ text thì lại theo điểm đặt text, Bạn có thể làm 1 file cad vẽ rõ mục đích của bạn không? Nó có giống như 1 leader ghi chú tọa độ k ??

Dạ đúng ạ! Nó giống như leader ghi chú tọa độ 1 điểm (X, Y) ra màn hình đó ah!

Nhờ bạn giúp dùm!

[ketxu 2.983]

Dạ đúng ạ! Nó giống như leader ghi chú tọa độ 1 điểm (X, Y) ra màn hình đó ah!

Nhờ bạn giúp dùm!

Bạn à, dù rằng yêu cầu có vẻ không khoai lắm, nhưng mình vẫn nghĩ bận nên làm 1 file CAD hoặc hình ảnh thể hiện rõ các bước thực hiện, cách thức nhập liệu, nhập những gì, kết quả ra sao...như vậy sẽ thuận lợi hơn cho người viết, cũng như bản thân bạn hiểu được vấn đề hơn, nếu không mình e bạn phải post yêu cầu nhìu lần đó ^^

P/S : đường pline gạch chân và X,Y lúc nào cũng ghi theo phương ngang à bạn ?

[Tue_NV 3.912]

Nhờ anh em sửa dùm em cái LISP tra cứu tọa độ điểm này dùm em với:

1/ Em kéo qua bên trái thì chữ nhảy qua bên phải, pline kẻ ngang phân cách X và Y lại nhảy qua bên trái.

2/ Pline kẻ ngang phân cách X và Y ngắn, trong khi X và Y thì dài quá, giờ làm sao X và y dài bao nhiêu thì Pline kẻ dài bấy nhiu.

3/ Sau khi lisp thực hiện xong trả lại bắt điem như ban đầu mình đang mặc định trong CAD (hiện nay là thực hiện xong nó tắt bắt đểm hết)

4/Và sao lisp thực hiện được mà trên dòng command vẫn hiện chữ "Unknown command "TCD"

Xin chân thành cảm ơn anh em.

Em gửi link nhờ anh em giúp dùm.

http://www.cadviet.com/upfiles/3/tra_cuu_toa_do_diem.lsp

Chào Truongthanh

1/ Pline thì bạn vẽ như thế nào nó đi như thế đó. Bạn vẽ từ p1-> p2->p3 thì nó vẽ đoạn P1p2 và p2p3

Còn Text vì nó sẽ viết ở điểm đặt Text và viết từ trái qua phải

Như vậy bạn thấy như điều số 1 bạn viết ở trên là như vậy

Cách khắc phục:

Bạn viết Text bình thường. Mỗi Text sinh ra lại lấy entity cho nó bằng hàm entlast. Bạn kiếm trên diễn đàn hàm TextBox để lấy chiều dài của Text bằng hàm TextBox mà di chuyển về vị trí cho phù hợp (đối với trường hợp vẽ p2p3 từ trái qua phải)

2. Sau khi lấy được chiều dài của Text bằng hàm TextBox. Bạn vẽ Pline từ P2 đến P3 với chiều dài đúng bằng chiều dài của Text là được. Bạn nên quan tâm đến việc xử lý góc nữa nhé. Hay góc của Text luôn = 0??

3.

(defun c:tcd()

(setq oldos (getvar "osmode")); lay che do bat diem hien hành

(setvar "osmode" 0); tắt chế độ bắt điểm

.......

.....

(setvar "osmode" oldos);trả lại chế độ bắt điểm

(princ)

)

4. Dòng này thừa 1 dấu ""

".circle" p1 1 ""

 

Tue_NV bận quá nên chỉ đưa ra gợi ý. Bạn tự hoàn thành nhé

Chúc thành công

[ketxu 2.983]

Dạ đúng ạ! Nó giống như leader ghi chú tọa độ 1 điểm (X, Y) ra màn hình đó ah!

Nhờ bạn giúp dùm!

Nếu các text lúc nào cũng nằm ngang thì bạn dùng thử cái này nhé.Hy vọng bạn bỏ chút thời gian nghiên cứu lisp để tự xây dựng những đoạn code nhỏ nhỏ cho mình :)

P/S : Trong code bạn post, mình không thấy có phần nào can thiệp vào OSnap mode cả, có thể là do đoạn khác bạn à.Mà nếu lúc chọn điểm mà tắt Ónap đi thì nghe cũng khó :)

(defun c:tcd (/ p1 p2 p3 X Y text1 text2 otext1 otext2 maxdtext)   
 (setvar "cmdecho" 0)
  (setq   kk " " )
 (while (= kk " ")
 (if (not #h) (setq #h (getreal "\nChon chieu cao chu: ")))
 (setq p1 (getpoint "\nChon diem can tra cuu tao do: ")
X (car p1)
Y (cadr p1)
p2 (getpoint p1 "\nChon diem dat text: ")
  )
 (command ".circle" p1 1)
 (command ".layer" "m" "gt-toa do nut" "c" "92" "gt-toa do nut" ""
   	   ".text" "j" "ml" (polar p2 (/ pi 2) #h) #h 0 (strcat "X = " (rtos X 2 2))
  ) 
 (setq text1 (entlast)
	otext1 (entget text1))
 (command   ".text" "j" "ml" (polar p2 (- (/ pi 2)) #h) #h 0 (strcat "Y = " (rtos Y 2 2))) 
 (setq text2 (entlast)
	otext2 (entget text2))
 (setq maxdtext (max (car(cadr (textbox otext1))) (car(cadr (textbox otext2)))))	   
     (if (	   (progn
	(command ".pline" p1 p2 (setq p3 (polar p2 pi maxdtext)) "")
	(command ".move" text1 text2 "" p2 p3)
   )
   (command ".pline" p1 p2 (polar p2 0 maxdtext) "")
  );end if
  );end while
 (princ)
 )

[truongthanh 7]

Nếu các text lúc nào cũng nằm ngang thì bạn dùng thử cái này nhé.Hy vọng bạn bỏ chút thời gian nghiên cứu lisp để tự xây dựng những đoạn code nhỏ nhỏ cho mình :)

P/S : Trong code bạn post, mình không thấy có phần nào can thiệp vào OSnap mode cả, có thể là do đoạn khác bạn à.Mà nếu lúc chọn điểm mà tắt Ónap đi thì nghe cũng khó :)

(defun c:tcd (/ p1 p2 p3 X Y text1 text2 otext1 otext2 maxdtext)   
 (setvar "cmdecho" 0)
  (setq   kk " " )
 (while (= kk " ")
 (if (not #h) (setq #h (getreal "\nChon chieu cao chu: ")))
 (setq p1 (getpoint "\nChon diem can tra cuu tao do: ")
X (car p1)
Y (cadr p1)
p2 (getpoint p1 "\nChon diem dat text: ")
  )
 (command ".circle" p1 1)
 (command ".layer" "m" "gt-toa do nut" "c" "92" "gt-toa do nut" ""
   	   ".text" "j" "ml" (polar p2 (/ pi 2) #h) h 0 (strcat "X = " (rtos X 2 2))
  ) 
 (setq text1 (entlast)
	otext1 (entget text1))
 (command   ".text" "j" "ml" (polar p2 (- (/ pi 2)) #h) #h 0 (strcat "Y = " (rtos Y 2 2))) 
 (setq text2 (entlast)
	otext2 (entget text2))
 (setq maxdtext (max (car(cadr (textbox otext1))) (car(cadr (textbox otext2)))))	   
     (if (< (car P2) X)
   (progn
	(command ".pline" p1 p2 (setq p3 (polar p2 pi maxdtext)) "")
	(command ".move" text1 text2 "" p2 p3)
   )
   (command ".pline" p1 p2 (polar p2 0 maxdtext) "")
  );end if
  );end while
 (princ)
 )

Dạ! Cái text và pline lúc nào cũng nằm ngang ah! Nó giống như file CAD dưới đây ah!

http://www.cadviet.com/upfiles/3/tcd.dwg

Còn cái lisp của bạn nó mất pline và tọa độ X, chỉ còn mỗi Y!

thanks bạn nhiều!

[ketxu 2.983]

Srr bạn,mình thiếu 1 dấu # ở dòng này

".text" "j" "ml" (polar p2 (/ pi 2) #h) h 0 (strcat "X = " (rtos X 2 2))

phải sửa lại là

".text" "j" "ml" (polar p2 (/ pi 2) #h) #h 0 (strcat "X = " (rtos X 2 2))

,mình edit lại code trong bài trước rồi, bạn down lại nhé :)

[truongthanh 7]

Anh Bình ởi! Nhờ anh sửa cái này dùm em lại 1 chút! Cái chỗ "NHAP CAO DO THIET KE DIEM:" nhờ anh sửa lại là "CHON CAO DO THIET KE DIEM" dùm em lun anh!Em đã có sẵn text trên màn hình rồi!Thanks anh nhiều!Làm phiền anh tí nữa nhé! Chứ cài này em xài OK rùi!

A Bình sửa lại CODE dum em với!

[ngocnam.cad 6]

Các bác ơi, em đã từng đọc ở diễn đàn mình và một số diễn đàn khác có nói về lisp đưa các trắc ngang vào viewport khung a3 nhưng down về mà làm mãi không dcj. MOng các bác giúp em với ạ. Hay bác nào có lisp đưa trắc ngang vào khung in bản vẽ a3 ti lệ 500 thì cho em xin. cám ơn các bác..hihi

[ythien 0]

mấy anh ơi giúp em với

em muốn chép chương trình cesmap để xuất dữ liệu từ cad sang exel gồm số thửa, loại đất, diện tích

anh em nào có chương trình này thì gửi cho em với

vì cesmap có menu phần xuất dữ liệu sang exel như file em đã gửi

em cám ơn nhiều!!

hoặc có giải pháp nào khác thì chỉ em với nhe

như minh hoạ

thank!!!!!

file kèm : http://www.cadviet.com/upfiles/3/hung_yen.dwg

[hungvq 0]

Mình vẫn dùng có thấy sao đâu nhỉ ^^ Đoạn lisp này của bác nào vào confirm lại giúp e với.Ngày xưa cứ cặm cụi down,giờ hok nhớ của ai để hỏi nữa :) E Dùng Cad08 thì không còn phần định chiều cao text trong lệnh text nữa, mà nó đi kèm theo Style, nên phải sửa lại trong các hàm tạo text bằng command ^^ Có lẽ nên chuyển sang entmake thì hay hơn :) Nhưng tạm thời cứ chữa cháy để bạn ấy dùng đã

;; free lisp from cadviet.com
(defun c:tdt()
 (setvar "cmdecho" 0)
 (setq lacol (getvar "CEColor"))
 (setq ladin (getvar "dimzin"))
 (setq laos (getvar "osmode"))  
 (if (not tl) (setq tl 1))
 (setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/")))
 (if tl1 (setq tl tl1))

 (setq     k 0 
   tdt 0)
 (setq ss (ssadd))

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq     P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command     "pline" PT P2 P5 P3 "C"
       "pline" P1 P4 ""
       "text" "m" P6  0 "Bang thong ke dien tich"
       "text" "m" P7  0 "STT"
       "text" "m" P8  0 "Dien tich (m2)"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
 (while (/= pt1 nil)
   (setq k (+ 1 k))
   (command "TEXT" "m" pt1  0 (rtos k 2 0))
   (setq     PT (list (car P3) (cadr P3))
   P1 (list (+ (car PT)(* 6 h)) (cadr PT))
   P2 (list (+ (car PT)(* 22 h)) (cadr PT))
   P3 (list (car PT) (- (cadr PT)(* 3 h)))
   P4 (list (car P1) (cadr P3))
   P5 (list (car P2) (cadr P3))
   P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
   P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
   P9 (list (car PT) (- (cadr P3)(* 3 h)))
   P10 (list (car P1) (cadr P9))
   P11 (list (car P2) (cadr P9))
   P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
   P13 (list (car P8) (cadr P12))
   );setq
   (command "CECOLOR" 4 "-boundary" pt1 "" )
   ;(setvar "CECOLOR" lacol)
   (setq et (entlast))
   (ssadd et ss)
   (command "area" "o" "last")                
   (setq et (entlast))
   (ssadd et ss)
   (setq dtcon (/ (* (getvar "AREA") tl tl) 1000000))
   (setq tdt (+ dtcon tdt))

(command "erase" ss "")

   (command "pline" PT P2 P5 P3 "C"
       "pline" P1 P4 ""
       "text" "m" P7  0 (rtos k 2 0)
       "text" "m" P8  0 (rtos dtcon 2 2))

   (setq pt1 (getpoint "\n Chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command     "pline" P3 P9 P11 P5 "C"
       "pline" P10 P4 ""
       "text" "m" P12  0 "Tong"
       "text" "m" P13  0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
) 

Chào bạn Ketxu! Rất cám ơn bạn đã post cho mình cái lip này. Nhưng mình vẫn chưa sử dụng được.

Mình bị vấp ngay ở đầu, có lẽ mình chưa hiểu việc chọn tỷ lệ bản vẽ. Mình đã chọn tỷ lệ 1/1; 1/200; 1/500; 1/1000; 1/2000... nhưng không thể tiếp tục được. Máy báo lỗi:

ty le ban ve < 1/1 >: 1/1

Chon diem xuat bang thong ke dien tich (mep trai):; error: bad argument type:

numberp: nil

Có phải tỷ lệ này chính là tỷ lệ bản vẽ cần tính diện tích không nhỉ? Mong bạn chỉ giáo tiếp nhé!

[ketxu 2.983]

Xin lỗi bạn ketxu có sai sót tí, mình đã bỏ mất phần khai báo biến h của bạn.Mình sửa lại trong code bài cũ rồi, bạn lấy lại nhé.

Nhớ là tạm thời khi dùng trong Text Style bạn để h = 0 đi, để các lệnh Text đúng khi có khai báo h text trong câu lệnh (lý do thì nêu ở bài đó rồi).Nếu điều này quá phiền toái thì mình sẽ sửa giúp bạn sau

Còn tỉ lệ thì bạn chỉ đánh số mẫu thôi.Ví dụ 1/100 thì bạn đánh 100 ở mục yêu cầu tỉ lệ nhé