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

[TokyoNhat 16]

Các anh ơi , em muốn nhờ các anh viết hộ 1 lisp .Từ dữ liệu đầu vào là file xcel cad sẽ vẽ cho 1 hình theo thứ từ các toạ độ (x,y) trong excel , giống như trong trắc địa để triền các điểm khống chế ta đo được vào bản vẽ với 1 khung bản vẽ cho sẵn giấy A0 hoặc A1 , A2 .Em đã tìm nhưng trên diễn đàn hình như là không có lisp phù hợp .Cám ơn các anh nhiều .

[phamngoctukts 714]

Chào bác Phamngoctukts,

Lisp của bác chưa giải quyêt vấn đề tạo boundary cho vùng hatch. Bản vẽ bạn Bachngoctung post lên hoàn toàn không có boundary của vùng hatch. Do vậy xài lisp của bác chưa được bác ạ.

Mặt khác như bạn ấy nói cái block của bạn ây đã được xác định, có tên hẳn hoi nên bác có thể xài luôn cái tên đó mà không cần kiểm tra mã DXF 66. Theo mình hiểu thì bạn ấy sẽ nhập vào block mới chứ không phải chỉnh sửa lại các block cũ bác ạ. Vậy nên bác có thể thay việc chọn block bằng việc insert block có tên do bạn ấy tự nhập thì hợp lý hơn.

Chào bác Bình! em làm đúng theo đầu bài của bạn đó cho mà Bác.

Đầu tiên là pick chọn hatch hoặc polyline kín

tiếp theo là chon pline để lấy chiều dài

cuối cùng là chọn vào block để ghi dữ liệu vào.

[TokyoNhat 16]

Các anh viết hộ em với , e đang cần lisp gấp .

[khaosat2009 11]

Em đang ở quê và mới lên quán NET, không có CAD ở đây nên chưa upload hình vẽ cụ thể cho bác được

Bác xem ở trong hàm WCMATCH nhé. Nó có đầy đủ cả đấy

Em có đọc sơ qua Lisp của bác bổ sung thêm vào trong Lisp của Tue_NV.

Tue_NV nghĩ rằng bác cứ Copy Text gốc ra làm 3 cái tại đúng vị trí của nó

- Cái đầu thay nội dung của chuỗi C1

- Cái thứ 2 thay nội dung của chuỗi C2. Move cái thứ 2 : 1 đoạn = "chiều dài chuỗi C1"

- Cái thứ 3 thay nội dung của chuỗi C3. Move cái thứ 3 : 1 đoạn = "chiều dài chuỗi C1+C2"

- Xoá cái text gốc đi

=> Thế là được

(Hy vọng bác Bình hiểu cái ý của Tue_NV trong ý "chiều dài chuỗi C1"

 

@khaosat : Lisp trên là của Tue_NV viết. Nếu bạn chịu khó chờ, mình sẽ giúp cho bạn

Cám ơn bạn Tue_NV đã quan tâm, Mình sẻ chờ bạn giúp.

[duy782006 1.544]

- Cái thứ 2 thay nội dung của chuỗi C2. Move cái thứ 2 : 1 đoạn = "chiều dài chuỗi C1"

- Cái thứ 3 thay nội dung của chuỗi C3. Move cái thứ 3 : 1 đoạn = "chiều dài chuỗi C1+C2"

Chiều dài chuỗi này mình cũng đã từng thử (lúc viết cái lisp biến 1 đoạn text thành 1 đám bock). Gá trị này chỉ mang tính tương đối cho từng loại font mà trong một loại font bước nhảy của từng ký tự cũng khác nhau. Đó là trường hợp đơn giản bảng mã VNI.*** chứ gặp bảng mã .VN*** thì các dấu hắn cũng tính là 1 ký tự. Nên cái quả này chua chủ yếu tách ra rồi người dùng tự move vậy hé hé.

[phamthanhbinh 3.146]

Em đang ở quê và mới lên quán NET, không có CAD ở đây nên chưa upload hình vẽ cụ thể cho bác được

Bác xem ở trong hàm WCMATCH nhé. Nó có đầy đủ cả đấy

Em có đọc sơ qua Lisp của bác bổ sung thêm vào trong Lisp của Tue_NV.

Tue_NV nghĩ rằng bác cứ Copy Text gốc ra làm 3 cái tại đúng vị trí của nó

- Cái đầu thay nội dung của chuỗi C1

- Cái thứ 2 thay nội dung của chuỗi C2. Move cái thứ 2 : 1 đoạn = "chiều dài chuỗi C1"

- Cái thứ 3 thay nội dung của chuỗi C3. Move cái thứ 3 : 1 đoạn = "chiều dài chuỗi C1+C2"

- Xoá cái text gốc đi

=> Thế là được

(Hy vọng bác Bình hiểu cái ý của Tue_NV trong ý "chiều dài chuỗi C1"

 

@khaosat : Lisp trên là của Tue_NV viết. Nếu bạn chịu khó chờ, mình sẽ giúp cho bạn

Hề hề hề,

Nhờ sự chỉ bảo của bác Tue_NV, mình sửa lại cái lisp viết cho bạn ceddtu như sau, xem ra nó ngon hơn cái cũ nhiều. Hẳn là bác Tue_NV sẽ hài lòng với kết quả này

(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 ((setq str (substr x (setq i (1+ i)) 3))
(if (= str " = ") (progn
(setq i2 (+ i 2))
(while ((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 els (entget y)
       b (cdr (assoc 41 els))
       p1 (cdr (assoc 10 els))
       h (cdr (assoc 40 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)
(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 2) (cons 7 st) (cons 40 h) (cons 41 b ))
)
)

)

 

Bạn ceddtu đâu rồi, cho ý kiến đi chứ nhể...

[phamthanhbinh 3.146]

Chào bác Bình! em làm đúng theo đầu bài của bạn đó cho mà Bác.

Đầu tiên là pick chọn hatch hoặc polyline kín

tiếp theo là chon pline để lấy chiều dài

cuối cùng là chọn vào block để ghi dữ liệu vào.

Hề hề hề,

Tại mình xem trên bản vẽ bạn ấy post thì mình hiểu như vậy. Có thể hiểu trật mà. Nhưng cái bản vẽ bạn ấy post thì chả có polyline kín nào cả bác Phamngoctukts ạ. Còn cái hatch thì lại bị xóa biên rồi. Mình xài CAD2004 nên chả thể nào làm lại cái biên ấy cả nên đành bó chiếu vậy.

Nếu chọn block rồi thay thuộc tính thì là công việc sửa chữa lại bản vẽ cũ, cái này cũng hay gặp nhưng việc sửa số liệu trên bản vẽ cũ thì mình thấy khá mạo hiểm. Bởi vì các số liệu cũ không còn nữa, mà người làm lúc trước có thể có lý do nào đó khi nhập số liệu ấy.

Còn insert block với thuộc tính mới vẫn có thể dùng để sửa chữa bản vẽ cũ vì lúc này mình sẽ có cả hai số liệu cũ và mới để đối chiếu, kiểm tra và hiệu chỉnh bác ạ. Theo mình thì có nhẽ phương án này hay hơn. Hề hề hề....

[ceddtu 6]

Hề hề hề,

Nhờ sự chỉ bảo của bác Tue_NV, mình sửa lại cái lisp viết cho bạn ceddtu như sau, xem ra nó ngon hơn cái cũ nhiều. Hẳn là bác Tue_NV sẽ hài lòng với kết quả này

(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 els (entget y)
       b (cdr (assoc 41 els))
       p1 (cdr (assoc 10 els))
       h (cdr (assoc 40 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)
(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 2) (cons 7 st) (cons 40 h) (cons 41 b ))
)
)

)

 

Bạn ceddtu đâu rồi, cho ý kiến đi chứ nhể...

Trước hết mình xin chân thành cám ơn bạn tue_nv, phamthanhbinh đã tận tình giúp đỡ mình, lisp cuối cùng mình down về sử dụng rất đúng ý mình, và tất nhiên kết quả thật mỹ mãn, ko có gì phải phàn nàn nữa cả, hy vọng sẽ gặp đc các bạn để tks 1 lần nữa

[tamkt 2]

Mong mọi người giúp em:

File cad đây ạ : http://www.mediafire.com/?77zyr67zh7jfh62

Em cám ơn mấy anh trước.

[phamngoctukts 714]

Hề hề hề,

Tại mình xem trên bản vẽ bạn ấy post thì mình hiểu như vậy. Có thể hiểu trật mà. Nhưng cái bản vẽ bạn ấy post thì chả có polyline kín nào cả bác Phamngoctukts ạ. Còn cái hatch thì lại bị xóa biên rồi. Mình xài CAD2004 nên chả thể nào làm lại cái biên ấy cả nên đành bó chiếu vậy.

Nếu chọn block rồi thay thuộc tính thì là công việc sửa chữa lại bản vẽ cũ, cái này cũng hay gặp nhưng việc sửa số liệu trên bản vẽ cũ thì mình thấy khá mạo hiểm. Bởi vì các số liệu cũ không còn nữa, mà người làm lúc trước có thể có lý do nào đó khi nhập số liệu ấy.

Còn insert block với thuộc tính mới vẫn có thể dùng để sửa chữa bản vẽ cũ vì lúc này mình sẽ có cả hai số liệu cũ và mới để đối chiếu, kiểm tra và hiệu chỉnh bác ạ. Theo mình thì có nhẽ phương án này hay hơn. Hề hề hề....

Bác dùng (Vla-get-area obj) thì chẳng cần quan tâm cái hatch đó có đường biên hay không bác ạ. Cái obj có thể là hatch hoặc polyline kín đều được Bác ạ.

[Phiphi- 176]

Trước hết mình xin chân thành cám ơn bạn tue_nv, phamthanhbinh đã tận tình giúp đỡ mình, lisp cuối cùng mình down về sử dụng rất đúng ý mình, và tất nhiên kết quả thật mỹ mãn, ko có gì phải phàn nàn nữa cả, hy vọng sẽ gặp đc các bạn để tks 1 lần nữa

Sao ceddtu không yêu cầu các Bác ấy viết thêm đoạn code xuất các data vừa chọn/tách thành các Excel sheets dùng cho việc cộng trừ nhân chia sau này luôn...

[ceddtu 6]

Sao ceddtu không yêu cầu các Bác ấy viết thêm đoạn code xuất các data vừa chọn/tách thành các Excel sheets dùng cho việc cộng trừ nhân chia sau này luôn...

dạ cái đó em đang tìm bác ạ, nếu tìm ko đc thì có lẽ lại phải nhờ các bác ấy thôi, hình như trong diễn đàn mình cũng có thì phải.tại lúc này mình đang làm bản vẽ thi công kl nhiều quá ko co thoi gian tìm, với lại phần xuất khối lượng sau khi tình tính xong diện tích.

[thangbkpro 0]

Các bạn giúp mình một lisp tự động nối những text có vị trí gần nhau hơn một khoảng định sẵn thành 1 text không bạn ? những text gần nhau tự nối với nhau và không nối với text khác!

Đại ý là:

Mình nhập lệnh gọi lip

Quét chuột toàn bộ bản vẽ

nhập khoảng cách text gần nhau dưới khoảng đó thì tự nối

enter

Vậy là text tự động được nối lại.

Ví dụ : bản vẽ của mình có rất nhiều 4 text gần nhau có dạng như: "MCB" "3P" "32A" "10kA" cùng mô tả về một thiết bị sẽ được nối thành các text "MCB 3P 32A 10kA". Sau đó mình thực hiện lisp đếm text của bạn gia_bach trên diễn đàn sẽ thống kê được số lượng và chủng loại thiết bị trong bản vẽ.

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

Thanks!:)

[nguyentuyen6 130]

Mong mọi người giúp em:

File cad đây ạ : http://www.mediafire.com/?77zyr67zh7jfh62

Em cám ơn mấy anh trước.

 

Líp 1:

 

(defun c:ss (/ dt1 dt2 p1 p2 p3 p4 p31 p32)
(command "undo" "be")
(setq dt1 (car (entsel "\n Chon doan thang dau tien: "))
  p1 (cdr (assoc 10 (entget dt1)))
  p2 (cdr (assoc 11 (entget dt1)))
)
(setq dt2 (car (entsel "\n Chon doan thang thu 2: "))
     p3 (cdr (assoc 10 (entget dt2)))
  p4 (cdr (assoc 11 (entget dt2)))
  )
(BatDau)
    (command "move" dt2 "" p3 p1)
	(setq  p31 (cdr (assoc 10 (entget dt2)))
           p41 (cdr (assoc 11 (entget dt2)))
	)
    (command "rotate" dt2 "" p31 "R" p31 p41 p2)
    (command "move" dt2 "" p1 p3)
(KetThuc)
(command "undo" "e")	  
)
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs))

 

Líp 2 : mình thấy bạn dùng lệnh copy có khi còn nhanh hơn là du`ng lisp.

[phamthanhbinh 3.146]

Bác dùng (Vla-get-area obj) thì chẳng cần quan tâm cái hatch đó có đường biên hay không bác ạ. Cái obj có thể là hatch hoặc polyline kín đều được Bác ạ.

Chào bác Phamngoctukts,

Khi mình dùng với bản vẽ của bạn ...... gì đó thì nó cho ra kết quả thế này bác ạ:

Command: (vl-load-com)

 

Command: (setq obj (vlax-ename->vla-object (car(entsel))))

 

Select object: # VLA-OBJECT IAcadHatch 06c011c4>

 

Command: (vla-get-area obj)

; error: ActiveX Server returned the error: unknown name: Area

 

Có nhẽ tại cái CAD2004 của mình chăng?????

[phamthanhbinh 3.146]

Các bạn giúp mình một lisp tự động nối những text có vị trí gần nhau hơn một khoảng định sẵn thành 1 text không bạn ? những text gần nhau tự nối với nhau và không nối với text khác!

Đại ý là:

Mình nhập lệnh gọi lip

Quét chuột toàn bộ bản vẽ

nhập khoảng cách text gần nhau dưới khoảng đó thì tự nối

enter

Vậy là text tự động được nối lại.

Ví dụ : bản vẽ của mình có rất nhiều 4 text gần nhau có dạng như: "MCB" "3P" "32A" "10kA" cùng mô tả về một thiết bị sẽ được nối thành các text "MCB 3P 32A 10kA". Sau đó mình thực hiện lisp đếm text của bạn gia_bach trên diễn đàn sẽ thống kê được số lượng và chủng loại thiết bị trong bản vẽ.

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

Thanks!:)

Chào bạn thangbkpro,

Sao bạn không block các nhóm đó lại thành các block với tên riêng, như vậy sẽ đơn giản hơn nhiều bạn ạ.

Yêu cầu của bạn cần phải thêm một vài yếu tố nữa do trên bản vẽ của bạn có khá nhiều loại text mà chùng lại cũng rất gần nhau, tương tự như các text bạn cần nối bạn ạ.

[nguyentuyen6 130]

Các bạn giúp mình một lisp tự động nối những text có vị trí gần nhau hơn một khoảng định sẵn thành 1 text không bạn ? những text gần nhau tự nối với nhau và không nối với text khác!

Đại ý là:

Mình nhập lệnh gọi lip

Quét chuột toàn bộ bản vẽ

nhập khoảng cách text gần nhau dưới khoảng đó thì tự nối

enter

Vậy là text tự động được nối lại.

Ví dụ : bản vẽ của mình có rất nhiều 4 text gần nhau có dạng như: "MCB" "3P" "32A" "10kA" cùng mô tả về một thiết bị sẽ được nối thành các text "MCB 3P 32A 10kA". Sau đó mình thực hiện lisp đếm text của bạn gia_bach trên diễn đàn sẽ thống kê được số lượng và chủng loại thiết bị trong bản vẽ.

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

Thanks!:)

 

Mình thấy cái này nhiều text làm được chắc cũng vất vả lắm. Nó phải xét k/c từ nó đến các text còn lại. nếu có n text thì phải xét n! trường hợp,. ặc ặc

[thangbkpro 0]

Mình thấy cái này nhiều text làm được chắc cũng vất vả lắm. Nó phải xét k/c từ nó đến các text còn lại. nếu có n text thì phải xét n! trường hợp,. ặc ặc

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.com/forum/index.php?sho...=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.

[phamthanhbinh 3.146]

dạ cái đó em đang tìm bác ạ, nếu tìm ko đc thì có lẽ lại phải nhờ các bác ấy thôi, hình như trong diễn đàn mình cũng có thì phải.tại lúc này mình đang làm bản vẽ thi công kl nhiều quá ko co thoi gian tìm, với lại phần xuất khối lượng sau khi tình tính xong diện tích.

 

Hề hề hề,

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

(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 ((setq str (substr x (setq i (1+ i)) 3))
(if (= str " = ") (progn
(setq i2 (+ i 2))
(while ((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))
       ;;;;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)
(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 2) (cons 7 st) (cons 40 h) (cons 41 b ))
)
(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) ) 

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

 

Sao ceddtu không yêu cầu các Bác ấy viết thêm đoạn code xuất các data vừa chọn/tách thành các Excel sheets dùng cho việc cộng trừ nhân chia sau này luôn...

 

Hề hề hề,

Cái nhà bác này chơi cái mửng muốn ăn gắp bỏ cho người hử????

Bác biết vậy sao hổng giúp luôn còn bày cái vụ hỏi khéo ấy hử????

Bác xài thử xem có vừa miệng không nhé. Tuy là của đi mót nhưng ngon đáo để bác ạ......

[tamkt 2]

Líp 1:

 

(defun c:ss (/ dt1 dt2 p1 p2 p3 p4 p31 p32)
(command "undo" "be")
(setq dt1 (car (entsel "\n Chon doan thang dau tien: "))
  p1 (cdr (assoc 10 (entget dt1)))
  p2 (cdr (assoc 11 (entget dt1)))
)
(setq dt2 (car (entsel "\n Chon doan thang thu 2: "))
     p3 (cdr (assoc 10 (entget dt2)))
  p4 (cdr (assoc 11 (entget dt2)))
  )
(BatDau)
    (command "move" dt2 "" p3 p1)
	(setq  p31 (cdr (assoc 10 (entget dt2)))
           p41 (cdr (assoc 11 (entget dt2)))
	)
    (command "rotate" dt2 "" p31 "R" p31 p41 p2)
    (command "move" dt2 "" p1 p3)
(KetThuc)
(command "undo" "e")	  
)
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs))

 

Líp 2 : mình thấy bạn dùng lệnh copy có khi còn nhanh hơn là du`ng lisp.

 

lisp 1 thì không áp dụng được với pline và leader, anh chỉnh lại giúp e nha.

lisp 2 thì e vẫn cần, vì 2 chiều cao chữ khác nhau, nhưng cùng layer và Block.

E cám ơn anh.

[bachngoctung 11]

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.

[phamngoctukts 714]

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

[Tue_NV 3.912]

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.com/forum/index.php?sho...=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:

[khaosat2009 11]

@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.com/upfiles/3/yeucau.rar

[thanhvienmoi1981 0]

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.com/upfiles/3/vd_8.rar