Đế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

#2421 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 31 October 2010 - 12:06 AM

Của bạn đây. Đúng với file bạn up lên.


(defun c:dtcd ()
(setq dth (car (entsel "\nChon vung can tinh dien tich"))
pl (car (entsel "\nChon pline can tinh chieu dai"))
ob1 (vlax-ename->vla-object dth)
ob2 (vlax-ename->vla-object pl)
dientich (vla-get-area ob1)
chieudai (vla-get-length ob2)
blatt (car (entsel "\nChon block attribute"))
ent (entget blatt))
(if (= (cdr (assoc 66 ent)) 1)
(progn
(setq name1 (entnext blatt)
ent1 (entget name1))
(entmod (subst (cons 1 (rtos dientich 2 2)) (assoc 1 ent1) ent1))
(entupd blatt)
(setq name2 (entnext name1)
ent2 (entget name2))
(entmod (subst (cons 1 (rtos chieudai 2 2)) (assoc 1 ent2) ent2))
(entupd blatt)
)
(alert "doi tuong duoc chon khong phai la block attibute")
)
)

-Mình cám ơn bạn phamngoctukts rất nhiều , mình đã thử lisp của bạn viết cho , đáp ứng đúng nhu cầu của mình, cám ơn bạn.
- Mình muốn nhờ phamngoctukts chỉnh sửa lại lisp trên một chút nữa để mình có thể ứng dụng nó nhanh hơn nữa . Ý kiến của mình như sau:
+ Mình muốn từ lisp trên sau buớc chọn hatch (or pline khép kín ) và pline (or line ) thì sẽ là dòng nhắc " chọn vị trí cần chen block" (ở đây là block BG như trong bản vẽ mình gửi ). Kết quả cho ra là Block BG song song với đuờng pline(or line) mà mình đã chọn để đo chiều dài, cùng với nó là có luôn mũi tên chỉ dẫn và cacs giá trị diện tích ,chiều dài đuợc điền.
- Cám ơn bạn phamngoctukts và mọi nguời đã quan tâm.
  • 0

#2422 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 31 October 2010 - 03:16 AM

-Mình cám ơn bạn phamngoctukts rất nhiều , mình đã thử lisp của bạn viết cho , đáp ứng đúng nhu cầu của mình, cám ơn bạn.
- Mình muốn nhờ phamngoctukts chỉnh sửa lại lisp trên một chút nữa để mình có thể ứng dụng nó nhanh hơn nữa . Ý kiến của mình như sau:
+ Mình muốn từ lisp trên sau buớc chọn hatch (or pline khép kín ) và pline (or line ) thì sẽ là dòng nhắc " chọn vị trí cần chen block" (ở đây là block BG như trong bản vẽ mình gửi ). Kết quả cho ra là Block BG song song với đuờng pline(or line) mà mình đã chọn để đo chiều dài, cùng với nó là có luôn mũi tên chỉ dẫn và cacs giá trị diện tích ,chiều dài đuợc điền.
- Cám ơn bạn phamngoctukts và mọi nguời đã quan tâm.

Bạn thử code mới này xem sao nhé

(defun c:dtcd ()
(vl-load-com)
(setq dd (entsel "\nChon vung can tinh dien tich")
dth (car dd)
ll (entsel "\nChon pline can tinh chieu dai")
pl (car ll)
ob1 (vlax-ename->vla-object dth)
ob2 (vlax-ename->vla-object pl)
dientich (vla-get-area ob1)
chieudai (vla-get-length ob2)
pblock (getpoint "\nChon diem chen block")
oldos (getvar "osmode")
)
(setvar "osmode" 0)
(if (= (cdr (assoc 0 (entget pl))) "LINE")
(setq ang (/ (* (vla-get-angle ob2) 180) pi))
(progn
(setq lis (acet-geom-vertex-list pl))
(setq ang (/ (* (angle (car (reverse lis)) (cadr (reverse lis))) 180) pi))
)
)
(vl-cmdf "insert" "BG" pblock "" "" ang (rtos dientich 2 2) (rtos chieudai 2 2))
(setq pp (polar pblock (/ (* ang pi) 180) 7.7636))
(vl-cmdf "move" (entlast) "" pblock pp)
(vl-cmdf "line" (car (cdr dd)) pblock "")
(vl-cmdf "line" (car (cdr ll)) pblock "")
(setvar "osmode" oldos)
)

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

#2423 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 31 October 2010 - 06:36 AM

Mình nghĩ là được bởi đã có lip viết để xóa các text gần nhau hơn một khoảng cho trước ở đây mà. Mình nghĩ là nối thì cũng sẽ làm được chứ ?
http://www.cadviet.c...o...=23110&st=0
@binh: Nếu mình thiết kế từ đầu thì mình sẽ dùng block. Mình chỉ làm dự toán thôi. Bên mình nhận bản vẽ từ đủ các phong cách vẽ của các bạn tư vấn thiết kế. Mỗi người một kiểu nên trộm nghĩ thống kê theo text là ổn nhất?
Các text khác nối lại với nhau cũng không sao. Mình chỉ cốt sao nối được các text tương tự như MCB 3P 100A 15kA lại thành 1 text và text này không bị nối với text ở ngoài thôi.
Giúp mình nhé mọi người.

Chào bạn thangbkpro. Bạn sử dụng thử cái này :

(defun c:ntt(/ ss i p h L ssc ent entt)
(IF (setq ss (ssget (list(cons 0 "text") (cons 1 "*#ka,#kA"))))
(PROGN
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq p (cdr(assoc 10 (entget ent))) ssc nil)
(setq h (cdr(assoc 40 (entget ent))))
(setq L (list (+ (car p) (* 2.5 h)) (+ (cadr p) (* 6 h)) 0.0))
(setq ssc (ssget "c" p L))
(if (setq ssc (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssc)))
'(lambda (x y) (> (caddr(assoc 10 (entget x)))
(caddr(assoc 10 (entget y)))
)
)
)
)
(PROGN
(setq entt (entget (car ssc)))
(setq entt (subst (cons 1 (apply 'strcat (mapcar '(lambda(x) (strcat (cdr(assoc 1 (entget x))) " ")) ssc)))
(assoc 1 entt) entt))
(entmod entt)
(mapcar 'entdel (vl-remove (car ssc) ssc))
))
)
))
)


@Bác Bình : Kết quả chạy rất tốt. Đúng với ý đồ của Tue_NV với cách xây dựng code có khác :)
Tuy nhiên, kết quả xuất Text không đúng khi Text xoay nghiêng 1 góc a khác 0. Cái này có lẽ User không cần thiết, nhưng mình nên bổ sung thêm cho đầy đủ, bác ạ

Hề hề hề,
Cái ni là mình mót của bác SSG đó, hãy cảm ơn bác ấy nha

Hề hề hề, bác Bình mót nhiều quá, đến nỗi bây chừ là không nhớ tên của tác giả của Lisp WritetoExCel nữa :D
Tác giả đã trả lời bác, tặng bác Lisp đó mà bác quên, đó là cái lỗi đó bác ạ :D Hề hề, cái này đáng phạt nha
Tác giả của của Lisp WritetoExCel không phải của bác SSG ạ. Tên của tác giả và Lisp WritetoExCel ở đây, bác ạ :
Bai viet so 160 - Lisp WritetoExCel
Cảm ơn tác giả của Lisp WritetoExCel nhiều lắm :)

@khaosat : Tue_NV có đọc yêu cầu của bạn. Nhưng có vài chổ chưa rõ lắm. Phiền bạn upload file .dwg và nói rõ hơn nhé.

@tamkt, nguyentuyen : Cái này thiết nghĩ không dùng Lisp. sử dụng CAD là được. Với lại, Lisp mà bạn nguyentuyen viết ra với điểm gốc Rotate ứng với điểm đầu Line. Nhìn vào CAD, nào đâu có biết điểm đầu hay là điểm cuối LINE cơ chứ??
Nếu User muốn xoay với điểm cuối Line thì sao, hoặc là điểm xoay nằm trên hoặc là không nằm trên đoạn LINE thì sao??
Lại còn áp dụng các đối tượng khác như bạn tamkt yêu cầu nữa : là LEADER và PLINE thẳng 1 phân đoạn nữa.

Lăn tăn chi bạn?? Áp dụng lệnh Rotate ới lựa chọn Reference và chế độ bắt điểm Parallel. Còn nếu thấy chế độ bắt điểm Parallel khó quá thì sử dụng lệnh Copy và sau đó là lệnh ROTATE hoặc là ALIGN

Tue_NV về quê có 1 ngày mà topic này rôm rả ghê. Chúc các bạn ngày cuối tuần vui vẻ. :bigsmile:
  • 2

#2424 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 31 October 2010 - 10:50 AM

@khaosat : Tue_NV có đọc yêu cầu của bạn. Nhưng có vài chổ chưa rõ lắm. Phiền bạn upload file .dwg và nói rõ hơn nhé.

Mình yêu cầu chọn các text trên cad -------> sang fille text.
http://www.cadviet.c...es/3/yeucau.rar
  • 0

#2425 thanhvienmoi1981

thanhvienmoi1981

    biết pan

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

Đã gửi 31 October 2010 - 11:01 AM

Các bạn viết dùm lisp xuất dữ liệu dạng text từ cad sang excel (xuất theo thứ tự các lớp trong một thửa khép kính tương ứng một lớp là một cột ) có file mẩu
http://www.cadviet.c...iles/3/vd_8.rar
  • 0

#2426 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 31 October 2010 - 11:03 AM

Bạn thử code mới này xem sao nhé


(defun c:dtcd ()
(vl-load-com)
(setq dd (entsel "\nChon vung can tinh dien tich")
dth (car dd)
ll (entsel "\nChon pline can tinh chieu dai")
pl (car ll)
ob1 (vlax-ename->vla-object dth)
ob2 (vlax-ename->vla-object pl)
dientich (vla-get-area ob1)
chieudai (vla-get-length ob2)
pblock (getpoint "\nChon diem chen block")
oldos (getvar "osmode")
)
(setvar "osmode" 0)
(if (= (cdr (assoc 0 (entget pl))) "LINE")
(setq ang (/ (* (vla-get-angle ob2) 180) pi))
(progn
(setq lis (acet-geom-vertex-list pl))
(setq ang (/ (* (angle (car (reverse lis)) (cadr (reverse lis))) 180) pi))
)
)
(vl-cmdf "insert" "BG" pblock "" "" ang (rtos dientich 2 2) (rtos chieudai 2 2))
(setq pp (polar pblock (/ (* ang pi) 180) 7.7636))
(vl-cmdf "move" (entlast) "" pblock pp)
(vl-cmdf "line" (car (cdr dd)) pblock "")
(vl-cmdf "line" (car (cdr ll)) pblock "")
(setvar "osmode" oldos)
)

- Cám ơn Tu nhé mình đã thử lisp bạn mới chỉnh giúp mình , nhưng thấy chưa được thỏa mãn, chắc là do mình diễn tả chưa rõ . Mình up file ảnh lên cho bạn tiện xem:
Hình đã gửi
+ Một là kết quả sau khi sử dụng lisp thì mũi tên chưa có Tu à , đồng thời block sau khi chèn ra nó lại tự đảo ngược vị trí của diện tích và chiều dài
- Tu xem khắc phục giúp mình nhé. Mình cũng up luôn cả file cad lên http://www.cadviet.c...advietcom_4.dwg
  • 0

#2427 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 31 October 2010 - 11:26 AM

Chào bạn thangbkpro. Bạn sử dụng thử cái này :


@Bác Bình : Kết quả chạy rất tốt. Đúng với ý đồ của Tue_NV với cách xây dựng code có khác :)
Tuy nhiên, kết quả xuất Text không đúng khi Text xoay nghiêng 1 góc a khác 0. Cái này có lẽ User không cần thiết, nhưng mình nên bổ sung thêm cho đầy đủ, bác ạ

Hề hề hề, bác Bình mót nhiều quá, đến nỗi bây chừ là không nhớ tên của tác giả của Lisp WritetoExCel nữa :D
Tác giả đã trả lời bác, tặng bác Lisp đó mà bác quên, đó là cái lỗi đó bác ạ :D Hề hề, cái này đáng phạt nha
Tác giả của của Lisp WritetoExCel không phải của bác SSG ạ. Tên của tác giả và Lisp WritetoExCel ở đây, bác ạ :
Bai viet so 160 - Lisp WritetoExCel
Cảm ơn tác giả của Lisp WritetoExCel nhiều lắm :)

@khaosat : Tue_NV có đọc yêu cầu của bạn. Nhưng có vài chổ chưa rõ lắm. Phiền bạn upload file .dwg và nói rõ hơn nhé.

@tamkt, nguyentuyen : Cái này thiết nghĩ không dùng Lisp. sử dụng CAD là được. Với lại, Lisp mà bạn nguyentuyen viết ra với điểm gốc Rotate ứng với điểm đầu Line. Nhìn vào CAD, nào đâu có biết điểm đầu hay là điểm cuối LINE cơ chứ??
Nếu User muốn xoay với điểm cuối Line thì sao, hoặc là điểm xoay nằm trên hoặc là không nằm trên LINE thì sao??
Lại còn áp dụng các đối tượng khác như bạn tamkt yêu cầu nữa : là LEADER và PLINE thẳng 1 phân đoạn nữa.

Lăn tăn chi bạn?? Áp dụng lệnh Rotate ới lựa chọn Reference và chế độ bắt điểm Parallel. Còn nếu thấy chế độ bắt điểm Parallel khó quá thì sử dụng lệnh Copy và sau đó là lệnh ROTATE hoặc là ALIGN

Tue_NV về quê có 1 ngày mà topic này rôm rả ghê. Chúc các bạn ngày cuối tuần vui vẻ. :bigsmile:

Hề hề hề,
Lỗi lớn , lỗi lớn, xin cám ơn bác Tue_NV đã nhắc nhở.
Xin lỗi bác Giabach vì sự nhầm lẫn.
Chịu phạt ạ, các bác cứ ra án lệnh rồi mình sẽ thi hành ngay ạ.
Hề hề hề.....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2428 ceddtu

ceddtu

    biết vẽ spline

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

Đã gửi 31 October 2010 - 01:00 PM

Hề hề hề,
Khỏi nhờ, nó đây, bạn dùng thử coi sao

bác phamthanhbinh oi, bac lam on sua gium em cai lisp tchu 1 tí đc ko ạ, em chỉ muốn đổi layer phần số thôi, còn phần đơn vị vẫn giữ nguyên (trong lisp đã đổi lun phần dơn vị cùng layer voi phần số rồi)
cám ơn bác nhiều lăm, may mà có bác với bác tue_nv chứ ko em no đòn
  • 0
Đời vắng mẹ hiền không phụ nữ.
Anh hùng thi sĩ hỏi còn đâu !

#2429 thangbkpro

thangbkpro

    biết zoom

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

Đã gửi 31 October 2010 - 03:01 PM

Chào bạn thangbkpro. Bạn sử dụng thử cái này :


(defun c:ntt(/ ss i p h L ssc ent entt)
(IF (setq ss (ssget (list(cons 0 "text") (cons 1 "*#ka,#kA"))))
(PROGN
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq p (cdr(assoc 10 (entget ent))) ssc nil)
(setq h (cdr(assoc 40 (entget ent))))
(setq L (list (+ (car p) (* 2.5 h)) (+ (cadr p) (* 6 h)) 0.0))
(setq ssc (ssget "c" p L))
(if (setq ssc (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssc)))
'(lambda (x y) (> (caddr(assoc 10 (entget x)))
(caddr(assoc 10 (entget y)))
)
)
)
)
(PROGN
(setq entt (entget (car ssc)))
(setq entt (subst (cons 1 (apply 'strcat (mapcar '(lambda(x) (strcat (cdr(assoc 1 (entget x))) " ")) ssc)))
(assoc 1 entt) entt))
(entmod entt)
(mapcar 'entdel (vl-remove (car ssc) ssc))
))
)
))
)

Cảm ơn bạn Tue_NV
Tuy nhiên khi dùng lip có một vài text của thiết bị này vẫn dính với text của thiết bị khác. Bạn có cách nào tối ưu hơn giúp mình không? Bạn có thể sửa lip theo đuôi *#CB không. Tại vì bên điện thì CB(aptomat) xuất hiện nhiều nhất(ACB, MCB, MCCB) và nó là chủ thể đi kèm với các thông số khác.
  • 0

#2430 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 31 October 2010 - 04:28 PM

Cảm ơn bạn Tue_NV
Tuy nhiên khi dùng lip có một vài text của thiết bị này vẫn dính với text của thiết bị khác. Bạn có cách nào tối ưu hơn giúp mình không? Bạn có thể sửa lip theo đuôi *#CB không. Tại vì bên điện thì CB(aptomat) xuất hiện nhiều nhất(ACB, MCB, MCCB) và nó là chủ thể đi kèm với các thông số khác.

Gửi bạn cái này. Bạn chú ý : Chọn 1 loạt luôn nhé.
Bạn chạy thử xem đã trúng ý chưa nhé :

(defun c:ntt(/ ss i p h L ssc ent entt)
(IF (setq ss (ssget (list(cons 0 "text") (cons 1 "*cb,*CB"))))
(PROGN
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq h (cdr(assoc 40 (entget ent))))
(setq p (cdr(assoc 10 (entget ent))) )
(setq p (list (car p) (+ (cadr p) (/ h 2)) 0.0))
(setq L (list (+ (car p) (* 2.0 h)) (- (cadr p) (* 6 h)) 0.0)
ssc nil)
(setq ssc (ssget "c" p L))
(if (setq ssc (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssc)))
'(lambda (x y) (> (caddr(assoc 10 (entget x)))
(caddr(assoc 10 (entget y)))
)
)
)
)
(PROGN
(setq entt (entget (car ssc)))
(setq entt (subst (cons 1 (apply 'strcat (mapcar '(lambda(x) (strcat (cdr(assoc 1 (entget x))) " ")) ssc)))
(assoc 1 entt) entt))
(entmod entt)
(mapcar 'entdel (vl-remove (car ssc) ssc))
))
)
))
)

  • 0

#2431 quan08

quan08

    biết vẽ pline

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

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

Nhờ các bác viết giùm e lisp đánh số thứ tự như file e gửi sau.Chân thành cảm ơn các bác trước.
http://www.cadviet.c...drawing1_29.dwg
  • 0

#2432 tuannt991

tuannt991

    biết pan

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

Đã gửi 31 October 2010 - 05:24 PM

Cho em xin lisp thống kê đường ống. trong bản vẽ pccc. Em muốn thống kê các loại ống. VD: DN32 dài bn mét. DN40, DN50,DN80... tổng cộng mỗi loại ống dài bn mét. em làm thủ công rất mất thời gian và hay bị nhầm. mong các anh giúp em.

http://www.cadviet.c.../0748fsp301.dwg đây là 1 trong nhung file em cần thống kế
  • 0

#2433 nguyentuyen6

nguyentuyen6

    biết lệnh chamfer

  • Advance Member
  • PipPipPipPip
  • 213 Bài viết
Điểm đánh giá: 124 (tàm tạm)

Đã gửi 31 October 2010 - 08:28 PM

Nhờ các bác viết giùm e lisp đánh số thứ tự như file e gửi sau.Chân thành cảm ơn các bác trước.
http://www.cadviet.c...drawing1_29.dwg

Mình mới làm xong cái làm từ phải sang trái, ban dùng thử nhé:

Bạn lưu ý là điểm đặt của text phải thẳng hàng nhé, lệch 1 tí là nó ghi sai luôn, hehe

(defun c:dstt (/ i n ss lst thay stt)
;====
;nguyentuyen6 @ CadViet
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(<
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)
;====
(setq i 0
n 1
)
(while (< i (sslength ss))
(setq
thay (itoa n)
stt (nth i lst)
)
(moddxf 1 thay stt)
(setq i (1+ i))
(setq n (1+ n))
)
)
(defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
;(reverse lstent)
)


Còn cái từ trái sang phải bạn thay dòng này là đc:

Thay:
(lambda (e1 e2)
(<
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))


Thành :

(lambda (e1 e2)
(>
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))

Bác nào giúp e gộp thành 1 líp với, hjx

  • 1

Lisp In bản vẽ hàng loạt:
http://www.cadviet.c...ndpost&p=139860


#2434 vtd_xd

vtd_xd

    biết vẽ circle

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

Đã gửi 31 October 2010 - 10:34 PM

Chào các bạn
Bạn nào có thể sửa giúp mình lisp "linkT" dùng được cho cả đối tượng Attribute Block.
Xin cảm ơn bác bạn trước nhé

Hình đã gửi

Đây là file ví dụ của mình: http://www.cadviet.c...3/cadviet_3.dwg


Chờ đợi mấy hôm mà chưa thấy tín hiện gì, bạn nào ra tay giúp mình với, cám ơn nhiều
  • 0
Chuc vui ve

#2435 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 31 October 2010 - 11:20 PM

Mình mới làm xong cái làm từ phải sang trái, ban dùng thử nhé:

Bạn lưu ý là điểm đặt của text phải thẳng hàng nhé, lệch 1 tí là nó ghi sai luôn, hehe

(defun c:dstt (/ i n ss lst thay stt)
;====
;nguyentuyen6 @ CadViet
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(<
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)
;====
(setq i 0
n 1
)
(while (< i (sslength ss))
(setq
thay (itoa n)
stt (nth i lst)
)
(moddxf 1 thay stt)
(setq i (1+ i))
(setq n (1+ n))
)
)
(defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
;(reverse lstent)
)


Còn cái từ trái sang phải bạn thay dòng này là đc:

Thay:
(lambda (e1 e2)
(<
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))


Thành :

(lambda (e1 e2)
(>
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))

Bác nào giúp e gộp thành 1 líp với, hjx

Mình gộp và rút ngắn cho bạn đây.

(defun c:dstt ()
(vl-load-com)
(setq ss (ssget '((0 . "TEXT")))
tp (getstring "\nBat dau tu: Trai/Phai: ")
lst (acet-ss-to-list ss)
lst (reverse lst)
lst (vl-sort lst
'(lambda (e1 e2)
(if (= (strcase tp) "T")
(<
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
(if (= (strcase tp) "P")
(>
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)
)
(setq i 0 n 1)
(while (< i (sslength ss))
(setq
thay (itoa n)
stt (nth i lst)
)
(moddxf 1 thay stt)
(setq i (1+ i))
(setq n (1+ n))
)
)

(defun moddxf (dxf chdxf ss /)
(entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss)))
)

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

#2436 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 31 October 2010 - 11:42 PM

bác phamthanhbinh oi, bac lam on sua gium em cai lisp tchu 1 tí đc ko ạ, em chỉ muốn đổi layer phần số thôi, còn phần đơn vị vẫn giữ nguyên (trong lisp đã đổi lun phần dơn vị cùng layer voi phần số rồi)
cám ơn bác nhiều lăm, may mà có bác với bác tue_nv chứ ko em no đòn

Chào bạn ceddtu,
Thực tế mình không đổi layer của thằng nào cả mà là cái text được tạo ra trên layer hiện hành của bản vẽ. Với bản vẽ của bạn post thì layẻ đó là layer có tên DMM, mà thôi.
Việc bạn muốn cái text chỉ đơn vị vẫn nằm ở lớp cũ của nó là layer XVOL thì có ngay, song nếu bạn muốn cái số nó nằm ở layer nào thì mình chưa rõ. Vậy nên mình vẫn để nó nằm trên layer hiện hành. Nếu bạn muồn nó nằm ở layer nào thì hãy bổ sung đoạn code sau ( cons 8 Tenlayer) vào trong cái list của hàm entmake nhé.
Mình cũng bổ sung trường hợp khi text của bạn bị xiên góc bạn nhé mặc dù có thể bạn không cần. Hề hề hề...
Đây là cái đã sửa:

(defun c:tchu(/ L pat ents i2 i3 i str str2 C1 C2 C3)
(setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "." ","))
(setq ents (acet-ss-to-list (ssget '((0 . "TEXT") (1 . "* = #*"))))
L '() i2 nil)

(foreach y ents
(setq x (cdr (assoc 1 (entget y))))
(setq i 1 L1 "" L2 "")
(while (< i (strlen x))
(setq str (substr x (setq i (1+ i)) 3))
(if (= str " = ") (progn
(setq i2 (+ i 2))
(while (< i2 (strlen x))
(if (vl-position (setq str2 (substr x (setq i2 (1+ i2)) 1)) pat)
(setq L1 (strcat L1 str2) i3 i2)
(setq i2 (strlen x))
)
)
) )
)
(setq C1 (substr x 1 (- i3 (strlen L1)))
C2 (substr x (1+ (strlen C1)) (strlen L1))
C3 (substr x (1+ i3) (- i2 i3))
)
;;;;;(alert (strcat C1 "\n" C2 "\n" C3))
(setq ltxt (list (substr C1 1 (- (strlen C1) 3 )) C2 C3))
(setq els (entget y)
b (cdr (assoc 41 els))
p1 (cdr (assoc 10 els))
h (cdr (assoc 40 els))
la (cdr (assoc 8 els))
g (cdr (assoc 50 els))
;;;;p2 (list (+ (car p1) (* b h 0.85 (1+ (strlen C1)))) (cadr p1))
;;;;p3 (list (+ (car p2) (* b h 0.85 (1+ (strlen L1)))) (cadr p2))
st (cdr (assoc 7 els))
els (subst (cons 1 C1) (assoc 1 els) els)
;;;ent (cdr (assoc 0 els))
)
(entmod els)
(if (/= g 0)
(command "rotate" y "" p1 (- (* g (/ 180 pi))))
)
(setq pls (textbox els)
dis1 (- (caadr pls) (caar pls))
p2 (list (+ (car p1) dis1 (* b h )) (cadr p1))
)
(entmake
(list (cons 0 "text") (cons 10 p2) (cons 1 C2) (cons 62 3) (cons 7 st) (cons 40 h) (cons 41 b ))
)
(setq ent (entlast)
pls1 (acet-ent-geomextents ent)
dis2 (- (caadr pls1) (caar pls1))
p3 (list (+ (car p2) dis2 (* b h )) (cadr p2))
)
(entmake
(list (cons 0 "text") (cons 10 p3) (cons 1 C3) (cons 62 256) (cons 7 st) (cons 40 h) (cons 41 b ) (cons 8 la))
)
(setq ent1 (entlast))
(if (/= g 0)
(command "rotate" y ent ent1 "" p1 (* g (/ 180 pi)))
)
(setq L (append L (list ltxt)))

)
(writetoExcel L)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;
(defun WriteToExcel (lst_data / col row x xlApp xlCells)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property xlApp "Workbooks")
"Add")
"Sheets")
"Item" 1)
"Cells"))
(setq row 3)
(foreach pt lst_data
(setq col 2)
(foreach coor pt
(vlax-put-property xlCells 'Item row col coor)
(setq col (1+ col)))
(setq row (1+ row)) )
(vla-put-visible xlApp :vlax-true)
(mapcar
(function (lambda (x)
(vl-catch-all-apply
(function (lambda ()(if x (vlax-release-object x)))))))
(list xlCells xlApp))
(gc) (gc) )

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

#2437 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 01 November 2010 - 12:18 AM

Cho em xin lisp thống kê đường ống. trong bản vẽ pccc. Em muốn thống kê các loại ống. VD: DN32 dài bn mét. DN40, DN50,DN80... tổng cộng mỗi loại ống dài bn mét. em làm thủ công rất mất thời gian và hay bị nhầm. mong các anh giúp em.

http://www.cadviet.c.../0748fsp301.dwg đây là 1 trong nhung file em cần thống kế

Chào bạn tuannt991,
Để có thể làm bảng thống kê như bạn yêu cầu thì việc tổ chức bản vẽ của bạn phải thống nhất một số nguyên tắc nào đó. Xem bản vẽ của bạn thì trên cùng một tuyến ống bạn chỉ phân biệt kích thước ống bằng các text đơn giản như vậy, rất khó để tách các đoạn ống trên cùng một tuyến để tính chiều dài.
Theo mình thiển nghĩ, bạn nên cấu tạo lại bản vẽ , tỷ như mỗi loại đường kính ống bạn sử dụng một màu khác nhau chẳng hạn, hoặc giả kết hợp với linetype để thể hiện cũng như sử dụng các pline với chiều dày khác nhau.
Dùng cách nào tùy bạn lựa chọn nhưng cần phải thống nhất trên tất cả các bản vẽ, có vậy việc thống kê mới có thể dễ dàng và thuận lợi cho bạn được. Nhất là khi bạn lại phải vẽ hàng ty tỷ bản vẽ kiểu này.
Với bản vẽ hiện tại như vầy, quả thật việc thống kê không hề dễ dàng. Rất mong bạn lưu tâm cải thiện công việc của bạn....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2438 tuannt991

tuannt991

    biết pan

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

Đã gửi 01 November 2010 - 02:24 AM

Chào bạn tuannt991,
Để có thể làm bảng thống kê như bạn yêu cầu thì việc tổ chức bản vẽ của bạn phải thống nhất một số nguyên tắc nào đó. Xem bản vẽ của bạn thì trên cùng một tuyến ống bạn chỉ phân biệt kích thước ống bằng các text đơn giản như vậy, rất khó để tách các đoạn ống trên cùng một tuyến để tính chiều dài.
Theo mình thiển nghĩ, bạn nên cấu tạo lại bản vẽ , tỷ như mỗi loại đường kính ống bạn sử dụng một màu khác nhau chẳng hạn, hoặc giả kết hợp với linetype để thể hiện cũng như sử dụng các pline với chiều dày khác nhau.
Dùng cách nào tùy bạn lựa chọn nhưng cần phải thống nhất trên tất cả các bản vẽ, có vậy việc thống kê mới có thể dễ dàng và thuận lợi cho bạn được. Nhất là khi bạn lại phải vẽ hàng ty tỷ bản vẽ kiểu này.
Với bản vẽ hiện tại như vầy, quả thật việc thống kê không hề dễ dàng. Rất mong bạn lưu tâm cải thiện công việc của bạn....

anh ơi đây là bản vẽ của chủ đầu tư cấp cho, mình là bên bỏ thầu. Nên em nhận bản vẽ này về để tính toán số liệu để dự thầu, dự toán chi phí.... Chứ không phải do em vẽ :-s đó mới là cái khó anh àh.
  • 0

#2439 quan08

quan08

    biết vẽ pline

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

Đã gửi 01 November 2010 - 07:35 AM

Mình gộp và rút ngắn cho bạn đây.


(defun c:dstt ()
(vl-load-com)
(setq ss (ssget '((0 . "TEXT")))
tp (getstring "\nBat dau tu: Trai/Phai: ")
lst (acet-ss-to-list ss)
lst (reverse lst)
lst (vl-sort lst
'(lambda (e1 e2)
(if (= (strcase tp) "T")
(<
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
(if (= (strcase tp) "P")
(>
(cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)
)
(setq i 0 n 1)
(while (< i (sslength ss))
(setq
thay (itoa n)
stt (nth i lst)
)
(moddxf 1 thay stt)
(setq i (1+ i))
(setq n (1+ n))
)
)

(defun moddxf (dxf chdxf ss /)
(entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss)))
)

Nhưng vẫn chưa đánh đúng bạn ah.mình gửi lại file.Mong bạn sửa giùm.thanks
http://www.cadviet.c...awing1_29_1.dwg
  • 0

#2440 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 01 November 2010 - 08:19 AM

Chào các bạn
Bạn nào có thể sửa giúp mình lisp "linkT" dùng được cho cả đối tượng Attribute Block.
Xin cảm ơn bác bạn trước nhé

Hình đã gửi

Đây là file ví dụ của mình: http://www.cadviet.c...3/cadviet_3.dwg

Lisp "link" cho đối tượng Block thuộc tính.
(link tất cả thuộc tính của Block)
(defun c:linkBA (/ e i obj obj1 ss1 ss2 vallst val); link Block Attribute
(vl-load-com)
(if (and
(princ "\nChon Block nguon :")
(setq ss1 (ssget "+.:S:N" (list (cons 0 "INSERT") (cons 66 1))))
(setq obj1 (vlax-Ename->Vla-Object (ssname ss1 0)))
(princ "\nChon Block dich :")
(setq ss2 (ssget "_:L" (list (cons 0 "INSERT") (cons 2 (vla-get-name obj1))))))
(progn
(foreach att (vlax-invoke obj1 'GetAttributes)
(setq valLst (cons (cons (vla-get-TagString Att)
(vla-get-ObjectId Att)) valLst)) )
(setq i -1)
(while (setq e (ssname ss2 (setq i (1+ i))))
(setq obj (vlax-Ename->Vla-Object e))
(foreach att (vlax-invoke obj 'GetAttributes)
(if (setq val (assoc (vla-get-TagString att) valLst))
(vla-put-TextString Att (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string (cdr val))
">%).TextString >%")) )) ) ) )
(princ))

  • 1