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

[ro88 2]

chào các bạn! mình đang làm khảo sát và đo vẽ địa hình,nhờ các bạn viết giúp mình lisp chèn hàng loạt các block khác nhau trên mọt bản vẽ.(ví dụ điểm số 001(stt) là cây cổ thụ,002 cây dừa,006 chùa,......) những block mỗi lần muốn chèn vào phải vào menu insert >>>>block>>>>rồi mới lấy ra để chèn.điều này sẽ rất lâu.khi đã lấy ra một block còn phải tìm điểm để chèn nữa .nhờ các bạn viết giúp mình nhé.có thể là ở dòng comand gõ lệnh...........>>>>>stt "001"(là một điêm mia ngoài thực địa có cả toạ độ và cao độ)>>>tên block muốn chèn "cây cổ thụ">>>ENTER......

mình sẽ up lên một file mẫu http://www.mediafire.com/?ny6flp5ylk4aqzx

thanks all. mong các bạn giúp nhé

sao không thấy ai giúp hết vậy.

[phamthanhbinh 3.146]

sao không thấy ai giúp hết vậy.

Hề hề hề,

Kêu lắm làm chi cho rát cổ vậy. Cứ củ từ cho chắc bạn ạ.

Bạn dùng thử cái này coi đã ưng ý chưa, nếu chưa thì pót lên và chịu khó đợi nghen. Đừng làm mất trật tự trên diễn đàn. Hề hề hề...

(defun c:nbl ()
(setq mia (getstring T "\n Nhap diem mia : ")
       bln (getstring T "\n Nhap ten block: ")
)
(setq ss (ssget "x" (list (cons 0 "text") (cons 1 mia)))
       n (sslength ss)
       i 0
)
(while (       (setq etxt (ssname ss i)
              ptxt (cdr (assoc 10 (entget etxt)))
      )
      (if (tblsearch "block" bln)
          (command "insert" bln ptxt "" "" "")
          (alert (strcat "Khong co block mang ten"  bln))
      )
      (setq i (1+ i))
)
)

 

Không ai giúp vì không ai rảnh, vì không ai hiểu, vì không ai muốn, vì ..... vì..... vì......

Phải biết kiên nhẫn bạn ạ, quan cần mà dân chửa vội, quan vội thì quan lội mà đi. Mọi sự giúp đỡ đều phải có thời gian của nó chứ không phải cứ muốn là phải có người giúp bạn hiểu chứ....

Hề hề hề.....

[phamvanthiet108 11]

Chào Các Bác ! . Em có bản vẽ cần tính diện tích phần hacth. Em đã tìm các lisp trên diễn đàn nhưng ko giải quyết được. em gửi file đó lên mong các Bác giúp em. Cám ơn Các Bác nhiều.

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

[VUVUZELA 100]

Chào Các Bác ! . Em có bản vẽ cần tính diện tích phần hacth. Em đã tìm các lisp trên diễn đàn nhưng ko giải quyết được. em gửi file đó lên mong các Bác giúp em. Cám ơn Các Bác nhiều.

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

 

Dễ luôn

Explode nó ra

Xong vẽ PLINE theo phương pháp bắt điểm nối lại từng điểm của line đã nổ HATCH

Tính diện tích là xong

Hehe

Khỏi cần lisp liếc j cả

:lol:

[ketxu 2.984]

Dễ luôn

Explode nó ra

Xong vẽ PLINE theo phương pháp bắt điểm nối lại từng điểm của line đã nổ HATCH

Tính diện tích là xong

Hehe

Khỏi cần lisp liếc j cả

:lol:

Thế thì chết :lol:

File của bạn ấy gửi lên cũng k phải là có nhiều miền hatch,nhưng do miền hatch lắm spl quá,nên các lisp tạo đường bo hàng loạt bị rối.Kết hợp bo = lisp,bo = thủ công + lisp nối đường thẳng thành pl + lisp tính tổng các miền pl thì giải quyết triệt để hơn.

[tamkt 2]

Hị hị làm reng mà đc cái này là hàm con mà. Bạn thích cái chiều dày nhập vào phải ko? chờ chút sửa cho chứ khó gì

Đây nì

(Defun C:xtdpl ( )

(command "undo" "be")

(Prompt "\nChon doi tuong pline")

(setq doituong1 (entsel))

(while

(null doituong1)

(Prompt "\nChon doi tuong pline")

(setq doituong1 (entsel))

)

(setq doituongt (car doituong1))

(setq doituong (entget doituongt))

(setq drong (getstring "\nNhap do rong:"))

(setq TENFILELUUKETQUA (getfiled "Chon file de luu ket qua .txt:" "" "txt" 1))

(setq FILEMODEVIET (open TENFILELUUKETQUA "a"))

(setq luubatdiem (getvar "osmode"))

(setvar "osmode" 0)

(setq sodinh (cdr (assoc 90 doituong)))

(setq Rec (acet-geom-vertex-list doituongt))

(setq ttd 0)

(while (< ttd sodinh)

(setq noidungdong (strcat (itoa (+ ttd 1)) ",d " drong "," (rtos (car (nth ttd Rec)) 2 1) "," (rtos (cadr (nth ttd Rec)) 2 1)))

 

(write-line noidungdong FILEMODEVIET)

(setq ttd (1+ ttd))

)

(setvar "osmode" luubatdiem)

(close FILEMODEVIET)

(command "undo" "end")

(Princ)

)

Thật tuyệt, nhanh và gọn, cám ơn anh nhe.

[tamkt 2]

Thật tuyệt, nhanh và gọn, cám ơn anh nhe.

Em lại có chủ đề mới nè,hihi...đây là file cad, mong mọi người giúp em...

file cad: http://www.mediafire.com/?nv53ffn3xoj3f9l

[phamngoctukts 714]

Em lại có chủ đề mới nè,hihi...đây là file cad, mong mọi người giúp em...

file cad: http://www.mediafire.com/?nv53ffn3xoj3f9l

Của bạn đây. Mình làm theo đúng nội dung trong file bạn gửi lên.

(defun c:tdt ()
(vl-load-com)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq ent (entget (nth i sslist)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No:  : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
)

[tamkt 2]

Của bạn đây. Mình làm theo đúng nội dung trong file bạn gửi lên.

(defun c:tdt ()
(vl-load-com)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq ent (entget (nth i sslist)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No:  : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
)

Quá tuyệt vời luôn anh, anh xử lý quá gọn nhẹ, hihi, thật tuyệt, em cám ơn anh Tú nhiều lắm lắm.

[VUVUZELA 100]

Thế thì chết :lol:

File của bạn ấy gửi lên cũng k phải là có nhiều miền hatch,nhưng do miền hatch lắm spl quá,nên các lisp tạo đường bo hàng loạt bị rối.Kết hợp bo = lisp,bo = thủ công + lisp nối đường thẳng thành pl + lisp tính tổng các miền pl thì giải quyết triệt để hơn.

 

hehe

Cái này theo tui nghĩ thì có thể xài thuật toán này

1. Exlpode các đối tưọng HATCH

2. QUét chọn từng vùng đã HATCH một

3. Đọc danh sách các LINE (gồm điểm 1 và điểm 2 của PLINE)

4. Sắp xếp thự tự các điểm đó theo thứ tự chọn khoảng cách nhỏ nhất (THUẬT TOÁN này thì em chịu)

5. Vẽ pline kín của vùng chọn là xong

[thiep 365]

hehe

Cái này theo tui nghĩ thì có thể xài thuật toán này

1. Exlpode các đối tưọng HATCH

2. QUét chọn từng vùng đã HATCH một

3. Đọc danh sách các LINE (gồm điểm 1 và điểm 2 của PLINE)

4. Sắp xếp thự tự các điểm đó theo thứ tự chọn khoảng cách nhỏ nhất (THUẬT TOÁN này thì em chịu)

5. Vẽ pline kín của vùng chọn là xong

Chào VUVUZELA,

Theo Thiep thì không nên nổ Hatch mà chỉ Hatchedit với tuỳ chọn SEPARATE để tách các hatch ra thành từng cái rời rạc. rồi dùng lisp tính diên tích đã có trên diễn đàn.

Còn nếu bạn muốn phục hồi đường bao hatch thì cũng đã có trên diễn đàn, thiep nhớ là đã đưa lisp này ở đâu đó.

[phamthanhbinh 3.146]

hehe

Cái này theo tui nghĩ thì có thể xài thuật toán này

1. Exlpode các đối tưọng HATCH

2. QUét chọn từng vùng đã HATCH một

3. Đọc danh sách các LINE (gồm điểm 1 và điểm 2 của PLINE)

4. Sắp xếp thự tự các điểm đó theo thứ tự chọn khoảng cách nhỏ nhất (THUẬT TOÁN này thì em chịu)

5. Vẽ pline kín của vùng chọn là xong

Hề hề hề,

Chào bác VUVUZELA ,

Cái miền hatch nó đặc tịt thỉ có nhẽ khả dĩ song nó lại có dăm vùng trống ở giữa mới là oái oăm bác ạ. Khi đó chắc lại phải gọi đến bác VAVAZELU mới xong bác hỉ????

[790312 5]

Của bạn đây. Mình làm theo đúng nội dung trong file bạn gửi lên.

(defun c:tdt ()
(vl-load-com)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq ent (entget (nth i sslist)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No:  : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
)

Bạn có thể thêm lựa chọn cho chọn vào trước hay sau của text và thêm vào text block thuộc tính luôn được khôn?Cảm ơn bạn trước.

[phamngoctukts 714]

Hề hề hề,

Chào bác VUVUZELA ,

Cái miền hatch nó đặc tịt thỉ có nhẽ khả dĩ song nó lại có dăm vùng trống ở giữa mới là oái oăm bác ạ. Khi đó chắc lại phải gọi đến bác VAVAZELU mới xong bác hỉ????

Chào bác bình em cũng đang nghiên cứu để viết lisp này nhưng đúng là nó xương thật. Vì bạn đó vẽ đường bao bằng spline nên khi dùng (vla-get-object obj) thì báo lỗi em đang chưa biết xử lý thế nào.

(defun c:dth ()
(setq ssh (ssget "x" '((0 . "HATCH")))
ssh (acet-ss-to-list ssh) dtt 0)
(foreach n ssh
(command "hatchedit" n "h" )
)
(setq ssht (ssget "x" '((0 . "HATCH")))
ssht (acet-ss-to-list ssht) i 0)
;(foreach n ssht
;(setq dt (vla-get-area (vlax-ename->vla-object n )))
;(setq listdt (append (list dt) listdt))
;;;;           )
(while (< i (length ssht))
(setq name (nth i ssht)
ob (vlax-ename->vla-object name)
dt (vla-get-area ob )
listdt (append (list dt) listdt)
)
(setq i (1+ i))
)
(setq dtt (apply '+ listdt))
(alert (strcat "tong dien tich hatch la: " (rtos dtt 2 3 )))
)

Lỗi thằng (nth 38 ssht) thằng này có đường bao bằng spline khi dùng hatchedit để lấy boundary -> dùng fatten để covert spl->pl thì đầu của pl nới này lại không trùng với pl của boundary do vậy không join lại được. "Cái này dùng tay thì dễ ợt."

[phamngoctukts 714]

Bạn có thể thêm lựa chọn cho chọn vào trước hay sau của text và thêm vào text block thuộc tính luôn được khôn?Cảm ơn bạn trước.

Mình không hiểu ý bạn lắm bạn có thể nói rõ hơn được không.?

[790312 5]

Mình không hiểu ý bạn lắm bạn có thể nói rõ hơn được không.?

File cad đây nhờ bạn giúp.Thanks.

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

[phamngoctukts 714]

File cad đây nhờ bạn giúp.Thanks.

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

Của bạn đây dùng với text hoặc mtext lệnh là tdt. Dùng với block ATT lệnh là tdb

;; free lisp from cadviet.com

(defun c:tdt ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq ent (entget (nth i sslist)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(setq tp (getstring "ban muon nhap Trai/Phai: "))
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(if (= tp "t")
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
(if (= tp "p")
(entmod (subst (cons 1 (strcat txt sym)) (assoc 1 (entget n)) (entget n)))
)
)
)

(defun c:tdb ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "INSERT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq name (nth i sslist))
(if (= (cdr (assoc 66 (entget name))) 1)
(progn
(setq ent (entget (entnext name)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(entupd name)
)
(alert "doi tuong duoc chon khong phai la block attribute")
)
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addb sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addb (ssb sym /)
(setq ssb (acet-list-to-ss ssb))
(setq j 0)
(setq tp (getstring "ban muon nhap Trai/Phai: "))
(while (< j (sslength ssb))
(setq ent (entget (ssname ssb j))
att (cdr (assoc 66 ent)))
(setq ent1 (entget (entnext (ssname ssb j))))
(setq txt (cdr (assoc 1 ent1)))
(if (= tp "t")
(progn
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
(if (= tp "p")
(progn
(entmod (subst (cons 1 (strcat txt sym )) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
(setq j (1+ j))
)
)

[790312 5]

Của bạn đây dùng với text hoặc mtext lệnh là tdt. Dùng với block ATT lệnh là tdb

;; free lisp from cadviet.com

(defun c:tdt ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq ent (entget (nth i sslist)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(setq tp (getstring "ban muon nhap Trai/Phai: "))
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(if (= tp "t")
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
(if (= tp "p")
(entmod (subst (cons 1 (strcat txt sym)) (assoc 1 (entget n)) (entget n)))
)
)
)

(defun c:tdb ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "INSERT"))))
(setq sslist (acet-ss-to-list ss))
(setq sslist (vl-sort sslist 
'(lambda (x y)
(and
(= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))))
(> (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y)))))
)
)
)
)
(setq i 0)
(setq sslist (reverse sslist))
(while (< i (length sslist))
(setq name (nth i sslist))
(if (= (cdr (assoc 66 (entget name))) 1)
(progn
(setq ent (entget (entnext name)))
(entmod (subst (cons 1 (rtos (1+ i) 2 0)) (assoc 1 ent) ent))
(entupd name)
)
(alert "doi tuong duoc chon khong phai la block attribute")
)
(setq i (1+ i))
)
(setq sy (getstring "Ban cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "ky tu muon them vao: "))
(addb sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addb (ssb sym /)
(setq ssb (acet-list-to-ss ssb))
(setq j 0)
(setq tp (getstring "ban muon nhap Trai/Phai: "))
(while (< j (sslength ssb))
(setq ent (entget (ssname ssb j))
att (cdr (assoc 66 ent)))
(setq ent1 (entget (entnext (ssname ssb j))))
(setq txt (cdr (assoc 1 ent1)))
(if (= tp "t")
(progn
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
(if (= tp "p")
(progn
(entmod (subst (cons 1 (strcat txt sym )) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
(setq j (1+ j))
)
)

Rất cảm ơn bạn.Nhưng nhờ bạn sửa lại giúp:Mình chỉ cần nó chèn vào text và text bloc ATT thôi còn giá trị của text và text block ATT vẫn giữ nguyên,không tăng theo cấp số cộng.

[phamngoctukts 714]

Rất cảm ơn bạn.Nhưng nhờ bạn sửa lại giúp:Mình chỉ cần nó chèn vào text và text bloc ATT thôi còn giá trị của text và text block ATT vẫn giữ nguyên,không tăng theo cấp số cộng.

Của bạn đây

;; free lisp from cadviet.com

(defun c:tdt ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss) er 0)
(setq sy (getstring "\nBan cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "\nky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(setq tp (getstring "\nban muon nhap Trai/Phai: "))
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(if (= tp "t")
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
(if (= tp "p")
(entmod (subst (cons 1 (strcat txt sym)) (assoc 1 (entget n)) (entget n)))
)
)
)

(defun c:tdb ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "INSERT"))))
(setq sslist (acet-ss-to-list ss))
(setq sy (getstring "\nBan cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "\nky tu muon them vao: "))
(addb sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addb (ssb sym /)
(setq ssb (acet-list-to-ss ssb))
(setq j 0)
(setq tp (getstring "\nban muon nhap Trai/Phai: "))
(while (< j (sslength ssb))
(setq ent (entget (ssname ssb j))
att (cdr (assoc 66 ent)))
(setq ent1 (entget (entnext (ssname ssb j))))
(setq txt (cdr (assoc 1 ent1)))
(if (= att 1)
(progn
(if (= tp "t")
(progn
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
(if (= tp "p")
(progn
(entmod (subst (cons 1 (strcat txt sym )) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
)
(alert "doi tuong duoc chon khong phai la block attribute")
)
(setq j (1+ j))
)
)

[tamkt 2]

Của bạn đây

;; free lisp from cadviet.com

(defun c:tdt ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq sslist (acet-ss-to-list ss) er 0)
(setq sy (getstring "\nBan cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "\nky tu muon them vao: "))
(addsym sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addsym (sst sym /)
(setq tp (getstring "\nban muon nhap Trai/Phai: "))
(foreach n sst
(setq txt (cdr (assoc 1 (entget n))))
(if (= tp "t")
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 (entget n)) (entget n)))
)
(if (= tp "p")
(entmod (subst (cons 1 (strcat txt sym)) (assoc 1 (entget n)) (entget n)))
)
)
)

(defun c:tdb ()
(vl-load-com)
(setq sslist (list))
(setq ss (ssget '((0 . "INSERT"))))
(setq sslist (acet-ss-to-list ss))
(setq sy (getstring "\nBan cos muon them ky tu vao khong Yes/No: : "))
(if (or (= sy "y") (= sy ""))
(progn
(setq tt (getstring "\nky tu muon them vao: "))
(addb sslist tt)
)
)
(if (= sy "n") (setq sy nil))
)

(defun addb (ssb sym /)
(setq ssb (acet-list-to-ss ssb))
(setq j 0)
(setq tp (getstring "\nban muon nhap Trai/Phai: "))
(while (< j (sslength ssb))
(setq ent (entget (ssname ssb j))
att (cdr (assoc 66 ent)))
(setq ent1 (entget (entnext (ssname ssb j))))
(setq txt (cdr (assoc 1 ent1)))
(if (= att 1)
(progn
(if (= tp "t")
(progn
(entmod (subst (cons 1 (strcat sym txt)) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
(if (= tp "p")
(progn
(entmod (subst (cons 1 (strcat txt sym )) (assoc 1 ent1) ent1))
(entupd (ssname ssb j))
)
)
)
(alert "doi tuong duoc chon khong phai la block attribute")
)
(setq j (1+ j))
)
)

 

Em nghĩ thế này nè, nếu vậy thì kết hợp được luôn:

1. Quét chọn các tex, nhập tdt

2. Líp hỏi: " bạn có muốn giữ nguyên text không": "y/n"

Nếu chọn "y" thì :

" Bạn có muốn số bắt đầu tăng"

ví dụ: nhập 5 thì các text tăng : 5,6,7,8...

nhập 100 thì các text tăng : 100,101,102,103....

Nếu chọn "n" thì:

" Bạn có muốn thêm kí tự vào không"

3. ......

4. ...... các bước tiếp theo thì cứ như lisp phía trên.

5. Kết thúc

 

Tương tự, Block ATT cũng vậy.

Không biết như vậy thì viết lisp quá phức tạp không nữa,

Mong anh giúp cho em với.

[VUVUZELA 100]

Chào VUVUZELA,

Theo Thiep thì không nên nổ Hatch mà chỉ Hatchedit với tuỳ chọn SEPARATE để tách các hatch ra thành từng cái rời rạc. rồi dùng lisp tính diên tích đã có trên diễn đàn.

Còn nếu bạn muốn phục hồi đường bao hatch thì cũng đã có trên diễn đàn, thiep nhớ là đã đưa lisp này ở đâu đó.

 

Tìm mãi mà không thấy Hatchedit với tuỳ chọn SEPARATE đâu cả bác ạ

[VUVUZELA 100]

Hề hề hề,

Chào bác VUVUZELA ,

Cái miền hatch nó đặc tịt thỉ có nhẽ khả dĩ song nó lại có dăm vùng trống ở giữa mới là oái oăm bác ạ. Khi đó chắc lại phải gọi đến bác VAVAZELU mới xong bác hỉ????

 

hehe

Bác bình tếu thật

Bởi vậy cái này mới khó nè, em tìm mãi mà không cho ra thuật toán : sắp xếp thứ tự các điểm theo khoảng cách nhỏ nhất theo chiều kim đồng hồ hay ngược chiều kim đồng hồ gì đó

Còn cái vùng trống thì có lẽ là chắc phải quét chọn theo kiểu Windows rồi tìm tập điểm trong vùng windows đó mà sắp xếp

Cái này có lẽ là phải nhờ đến bác NguyenHoanh thôi

:lol:

Khó thật . Đau đầu quá !

[phamngoctukts 714]

Tìm mãi mà không thấy Hatchedit với tuỳ chọn SEPARATE đâu cả bác ạ

Đây mà bác

Command: -hatchedit

Select hatch object:

Enter hatch option [DIsassociate/Style/Properties/DRaw order/ADd

boundaries/Remove boundaries/recreate Boundary/ASsociate/separate

Hatches/Origin] :

[Tue_NV 3.912]

Tìm mãi mà không thấy Hatchedit với tuỳ chọn SEPARATE đâu cả bác ạ

Bác sử dụng CAD phiên bản cũ chắc là không có. Chắc là bác nên cài Version CAD mới mà thôi <_>

Đây bác ạ :

Command: -HATCHEDIT

 

Select hatch object:

Enter hatch option [DIsassociate/Style/Properties/DRaw order/ADd boundaries/Remove boundaries/

recreate Boundary/ASsociate/separate Hatches/Origin] :

 

Trong hộp thoại Hatch edit Nó nằm ở mục Option

 

 

hehe

Cái này theo tui nghĩ thì có thể xài thuật toán này

1. Exlpode các đối tưọng HATCH

2. QUét chọn từng vùng đã HATCH một

3. Đọc danh sách các LINE (gồm điểm 1 và điểm 2 của PLINE)

4. Sắp xếp thự tự các điểm đó theo thứ tự chọn khoảng cách nhỏ nhất (THUẬT TOÁN này thì em chịu)

5. Vẽ pline kín của vùng chọn là xong

Cách của bác VUVUZELA xem ra không ổn. Cái Hatch này theo miền Spline , LINE hoặc PLINE

[phamvanthiet108 11]

Bác sử dụng CAD phiên bản cũ chắc là không có. Chắc là bác nên cài Version CAD mới mà thôi <_<

Đây bác ạ :

Command: -HATCHEDIT

 

Select hatch object:

Enter hatch option [DIsassociate/Style/Properties/DRaw order/ADd boundaries/Remove boundaries/

recreate Boundary/ASsociate/separate Hatches/Origin] :

 

Trong hộp thoại Hatch edit Nó nằm ở mục Option

Cách của bác VUVUZELA xem ra không ổn. Cái Hatch này theo miền Spline , LINE hoặc PLINE

Cám ơn các bác đã quan tâm.Em dung cad 2010 và nó bo đc từng miền mà em Hacth.Nhưng khi đó đo từng vùng một thì cũng vất lắm.Em cũng dùng lisp đo diện tích nhưng chưa đc. đây là file mà em đã bo từng miền hatch.

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

Em dung lisp này, với lệnh tính tổng diện tích (tdt) nó bị lỗi mong các bác giúp em.

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