Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

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


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#2341 790312

790312

    biết lệnh fillet

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

Đã gửi 23 October 2010 - 10:06 PM

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.c...hu_vao_text.dwg
  • 0

#2342 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 24 October 2010 - 12:41 AM

File cad đây nhờ bạn giúp.Thanks.
http://www.cadviet.c...hu_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))
)
)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2343 790312

790312

    biết lệnh fillet

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

Đã gửi 24 October 2010 - 06:46 AM

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.
  • 0

#2344 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 24 October 2010 - 09:34 AM

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))
)
)

  • 2
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2345 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 24 October 2010 - 09:55 AM

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.
  • 0

#2346 VUVUZELA

VUVUZELA

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 210 Bài viết
Điểm đánh giá: 97 (tàm tạm)

Đã gửi 24 October 2010 - 11:23 AM

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 ạ
  • 0

Hệ thống Liên Kết, Thiết Kế Tự Động

ttps://www.facebook...etThietKeTuDong


#2347 VUVUZELA

VUVUZELA

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 210 Bài viết
Điểm đánh giá: 97 (tàm tạm)

Đã gửi 24 October 2010 - 11:30 AM

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á !
  • 0

Hệ thống Liên Kết, Thiết Kế Tự Động

ttps://www.facebook...etThietKeTuDong


#2348 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 24 October 2010 - 11:30 AM

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] :
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2349 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 24 October 2010 - 11:37 AM

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
  • 0

#2350 phamvanthiet108

phamvanthiet108

    biết vẽ polygon

  • Members
  • PipPip
  • 73 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 25 October 2010 - 09:34 AM

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.c...les/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.c...3/lisp_binh.lsp
  • 0

#2351 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 25 October 2010 - 11:10 AM

(defun c:TDT ()
(vl-load-com)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nchon cac vung can tinh:")
(setq TH (ssget))
(setq SPT (sslength TH))
(setq TOCD 0 DEM 0 chu1a "")
(while (< DEM SPT)
(setq PT (ssname TH DEM)
CDPT (vlax-curve-getarea pt)
dsdinh (acet-geom-vertex-list pt)
TOCD (+ TOCD CDPT)
DEM (1+ DEM)
chu1a (strcat chu1a " + " (rtos cdpt 2 1))
)
(command "text" (car dsdinh) "5" "0" (rtos cdpt 2 1))
)
(setvar "cmdecho" cmd)
(Princ chu1a)
(princ (strcat "\nTong dien tich " (itoa dem) " vung la (m2):" (rtos tocd 2 1) " m2."))
(princ)
)

=====
Bạn cần lưu ý.
Đặt biến DIMLFAX là 100,đơn vị diện tích là m2
Diện tích mỗi vùng có ghi bằng text tại vùng đó
Cũng có thể diện tích sẽ trừ đi vì có các đảo trong lòng hồ.
Trong hình vẽ có 1 Spline Bạn xóa Pline đó đi vì vùng diện tích đã bao Spline đó rồi (thừa)
Bạn nên kiểm tra lại kết quả vì có 1 số hình kỳ dị...
  • 0

#2352 phamvanthiet108

phamvanthiet108

    biết vẽ polygon

  • Members
  • PipPip
  • 73 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 25 October 2010 - 11:26 AM

(defun c:TDT ()
(vl-load-com)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nchon cac vung can tinh:")
(setq TH (ssget))
(setq SPT (sslength TH))
(setq TOCD 0 DEM 0 chu1a "")
(while (< DEM SPT)
(setq PT (ssname TH DEM)
CDPT (vlax-curve-getarea pt)
dsdinh (acet-geom-vertex-list pt)
TOCD (+ TOCD CDPT)
DEM (1+ DEM)
chu1a (strcat chu1a " + " (rtos cdpt 2 1))
)
(command "text" (car dsdinh) "0" (rtos cdpt 2 1))
)
(setvar "cmdecho" cmd)
(Princ chu1a)
(princ (strcat "\nTong dien tich " (itoa dem) " vung la (m2):" (rtos tocd 2 1) " m2."))
(princ)
)

=====
Bạn cần lưu ý.
Đặt biến DIMLFAX là 100,đơn vị diện tích là m2
Diện tích mỗi vùng có ghi bằng text tại vùng đó
Cũng có thể diện tích sẽ trừ đi vì có các đảo trong lòng hồ.

ko đc bác ah.nó báo lỗi . Bác xem lại cho em với
  • 0

#2353 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

  • Members
  • PipPipPip
  • 116 Bài viết
Điểm đánh giá: 41 (tàm tạm)

Đã gửi 25 October 2010 - 02:07 PM

ko đc bác ah.nó báo lỗi . Bác xem lại cho em với

Bạn load lại bài viết trên nhé (đã sửa rồi).Báo lỗi vì chưa định chiều cao trong lệnh text.
Nếu vẫn báo lỗi thì Bạn up lỗi đó lên xem sao.
  • 0

#2354 phamvanthiet108

phamvanthiet108

    biết vẽ polygon

  • Members
  • PipPip
  • 73 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 25 October 2010 - 03:58 PM

Bạn load lại bài viết trên nhé (đã sửa rồi).Báo lỗi vì chưa định chiều cao trong lệnh text.
Nếu vẫn báo lỗi thì Bạn up lỗi đó lên xem sao.

Cám ơn Bác nhiều. Em mới thử thấy cũng tốt.
  • 0

#2355 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 25 October 2010 - 04:39 PM

ko đc bác ah.nó báo lỗi . Bác xem lại cho em với

Chào bạn Phamvanthiet108,
Bạn thử dùng cái này nhé. Mình cải tạo thêm từ chính cái lisp bạn đã post lên. Lưu ý rằng ở lisp này mình chỉ giải quyết đến mức độ đảo nhỏ cấp 1 thôi nhé. Nghĩa là nếu trong vùng chọn của bạn có vùng trống trong đảo cấp một là sẽ bị sai đó. Việc tổ hợp đảo và vùng trống nhiều cấp hiện tại mình chưa nghĩ ra giải pháp nào hợp lý cả. Lisp đã được chạy thử trên file bạn đã boundary xong chứ không phải file chưa tạo boundary bạn nhé. Việc tạo Boundary mình chưa giải quyết được.
Việc ghi diện tích ra file hay vẽ lên bản vẽ mình không làm do thiết nghĩ không phải quá khó đối với bạn.
Hy vọng bạn sẽ hài lòng dùng tạm.

(defun c:TDT ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nchon cac doan can tinh:")
(setq TH (ssget))
(setq SPT (sslength TH))
(setq TOCD 0 DEM 0 dtlst (list) ssent (ssadd) area1 0 )
(while (< DEM SPT)
(setq PT (ssname TH DEM))
(setq CSDL (entget pt))
(setq TDT (cdr (assoc 0 CSDL)))
(if (equal (cdr (assoc 70 csdl)) 1 0.0001)
(progn
(setq dtlst (append dtlst (list pt)))
(setq ssent (ssadd pt ssent))
)
)
(setq DEM (1+ DEM))
)
;;;;;;;;;(setq ssent1 (ssadd))
(foreach dt dtlst
(setq els (entget dt))
(setq plst (list))
(foreach a els
(if (= (car a ) 10)
(setq plst (append plst (list (cdr a ))))
)
)
(setq ss1 (ssget "WP" plst (list (cons 0 "lwpolyline"))))
(if ss1
(progn
(setq n (sslength ss1)
i 0
)
(while (< i n)
(setq en (ssname ss1 i )
ssent (ssdel en ssent )
)
(command "area" "o" en )
(setq area1 (+ area1 (getvar "area"))
i (1+ i)
)
)
;;;;;;;;;;;;;;;(setq ssent (ssdel dt ssent)
;;;;;;;;;;ssent1 (ssadd dt ssent1)
;;;;;;;;;;;;;;;:lol:
)
)


)
area1
ssent
(setq j 0)
(repeat (sslength ssent)
(setq ent (ssname ssent j))
(command "area" "o" ent)
(setq CDPT (getvar "AREA"))
(setq TOCD (+ TOCD CDPT) )
(setq j (1+ j))
)
(setq TOCD (- TOCD area1))

(setvar "cmdecho" cmd)
(princ "\nTong dien tich la:")
(setq TCD TOCD)
)



Chúc bạn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2356 phamvanthiet108

phamvanthiet108

    biết vẽ polygon

  • Members
  • PipPip
  • 73 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 25 October 2010 - 05:21 PM

Chào bạn Phamvanthiet108,
Bạn thử dùng cái này nhé. Mình cải tạo thêm từ chính cái lisp bạn đã post lên. Lưu ý rằng ở lisp này mình chỉ giải quyết đến mức độ đảo nhỏ cấp 1 thôi nhé. Nghĩa là nếu trong vùng chọn của bạn có vùng trống trong đảo cấp một là sẽ bị sai đó. Việc tổ hợp đảo và vùng trống nhiều cấp hiện tại mình chưa nghĩ ra giải pháp nào hợp lý cả. Lisp đã được chạy thử trên file bạn đã boundary xong chứ không phải file chưa tạo boundary bạn nhé. Việc tạo Boundary mình chưa giải quyết được.
Việc ghi diện tích ra file hay vẽ lên bản vẽ mình không làm do thiết nghĩ không phải quá khó đối với bạn.
Hy vọng bạn sẽ hài lòng dùng tạm.


(defun c:TDT ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nchon cac doan can tinh:")
(setq TH (ssget))
(setq SPT (sslength TH))
(setq TOCD 0 DEM 0 dtlst (list) ssent (ssadd) area1 0 )
(while (< DEM SPT)
(setq PT (ssname TH DEM))
(setq CSDL (entget pt))
(setq TDT (cdr (assoc 0 CSDL)))
(if (equal (cdr (assoc 70 csdl)) 1 0.0001)
(progn
(setq dtlst (append dtlst (list pt)))
(setq ssent (ssadd pt ssent))
)
)
(setq DEM (1+ DEM))
)
;;;;;;;;;(setq ssent1 (ssadd))
(foreach dt dtlst
(setq els (entget dt))
(setq plst (list))
(foreach a els
(if (= (car a ) 10)
(setq plst (append plst (list (cdr a ))))
)
)
(setq ss1 (ssget "WP" plst (list (cons 0 "lwpolyline"))))
(if ss1
(progn
(setq n (sslength ss1)
i 0
)
(while (< i n)
(setq en (ssname ss1 i )
ssent (ssdel en ssent )
)
(command "area" "o" en )
(setq area1 (+ area1 (getvar "area"))
i (1+ i)
)
)
;;;;;;;;;;;;;;;(setq ssent (ssdel dt ssent)
;;;;;;;;;;ssent1 (ssadd dt ssent1)
;;;;;;;;;;;;;;;:lol:
)
)


)
area1
ssent
(setq j 0)
(repeat (sslength ssent)
(setq ent (ssname ssent j))
(command "area" "o" ent)
(setq CDPT (getvar "AREA"))
(setq TOCD (+ TOCD CDPT) )
(setq j (1+ j))
)
(setq TOCD (- TOCD area1))

(setvar "cmdecho" cmd)
(princ "\nTong dien tich la:")
(setq TCD TOCD)
)



Chúc bạn vui.

Em rất cảm cảm bác Bình đã quan tâm đến vấn đề của em.
  • 0

#2357 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 25 October 2010 - 05:46 PM

Em rất cảm cảm bác Bình đã quan tâm đến vấn đề của em.

Hề hề hề,
Nếu có thể bác cho mình ngó cái lisp bác dùng để tạo boundary với. Mình loay hoay chưa ngộ ra cái đường lối chi cả. Phương án của bác Thiếp mình cũng đã có thấy xong giờ tìm hoài chửa ra nên không rõ có ứng dụng được vào trường hợp của bác hay không???
Trong bản vẽ bác post lên mình thấy có nhẽ có thể cải sửa cái việc tạo boundary của bác vì thực tế trên đó mình thấy còn khá nhiều đường polyline hở trùng với các boundary. Do vậy mình phải dùng phép chọ chỉ lấy các polyline kín để đỡ rối bác ạ.
Việc mình thấy khá hay là giải quyết trường hợp có nhiều boundary lồng nhau tạo thêm các đảo cấp hai, cấp ba, hay cấp 4 ..... nữa. Vì thực tế không phải hiếm các trường hợp này, nhất là với mấy cái vùng sông nước mênh mông như miền Nam này. Tuy nhiên nghĩ là vậy nhưng còn chửa tìm ra thuật toán sao cho hợp lý nhất. Rất mong các bác góp thêm ý kiến để có thể giải quyết tận gốc vấn đề này.
Hề hề hề.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2358 bachngoctung

bachngoctung

    biết lệnh copy

  • Members
  • PipPipPip
  • 115 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 25 October 2010 - 06:56 PM

- Mình muốn nhờ mọi người viết cho lisp điền giá trị đo được là diện tích (được pick chọn từ hatch or poline khép kín), chiều dài (được pick chọn từ pline, line vào block thuộc tính đã được lập sẵn.
- Cụ thể cấu trúc lisp như sau :
+ Tên lệnh : DTCD
+ Chọn vùng diện tích
+ Chọn đoạn thẳng
+ Chọn block cần điền ( block có tên BG đã đc lập sẵn)
- Chú ý : phải chọn diện tích trước vì thứ tự điền giá trị trong block thuộc tính mình đã lập là để diện tích trước xong đến chiều dài.
- Anh em xem giùm nhé,có chỗ nào chưa rõ ý của mình thì để mình nói thêm dau nhé.
- Link file cad kèm theo: http://www.cadviet.c.../cadvietcom.dwg
- Cám ơn đã quan tâm .
  • 0

#2359 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 25 October 2010 - 07:28 PM

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.


Em nghĩ chắc vấn đề này khó quá nên không thấy ai trả lời,
nói chung có mấy lisp cũ xài cũng tuyệt lắm rùi, hehe....
  • 0

#2360 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 25 October 2010 - 08:16 PM

Em nghĩ chắc vấn đề này khó quá nên không thấy ai trả lời,
nói chung có mấy lisp cũ xài cũng tuyệt lắm rùi, hehe....

Bạn cứ "gáy" anh em. Mình sẽ giúp bạn. Vấn đề này cũng không khó lắm mình nghĩ bạn cũng làm được nên không động đến.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!