Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

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

Các bài được khuyến nghị

phamthanhbinh    3.123
Còn phần nối text nữa anh phamngoctukts giúp em với .

Lisp nối text của bạn đây:

(defun c:comtxt ( / ss1 ss2 p1 p2 t1 txt els1 els2 t2 )
(vl-load-com)
(alert "\nChon doi tuong can noi")
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 1 "*.")))))
(alert "\n Chon doi tuong noi")
(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 1 "##")))))
(command "undo" "be")
(foreach x ss1
      (setq els1 (entget x)
              p1 (cdr (assoc 10 els1))
              p2 (cdr (assoc 11 els1))
              t1 (cdr (assoc 1 els1))
              txt ""
      )
      (foreach y ss2
              (setq els2 (entget y)
                      t2 (cdr (assoc 1 els2))
              )
              (if (equal (cdr (assoc 10 els2)) p2 0.01)
                  (progn
                  (setq txt (strcat t1 t2))
                  (command "erase" y "")
                  )
              )
       )
       (if (/= txt "")
           (progn
                 (setq els1 (subst (cons 1 txt) (assoc 1 els1) els1)
                         els1 (subst (cons 72 0) (assoc 72 els1) els1)
                         els1 (cons (cons 62 3) els1)
                 )
                 (entmod els1)

          )
       )
)
(command "undo" "e")
(princ)
)

 

Chú ý: lisp này mình cho đổi màu các text đã được nối để bạn dễ kiểm tra xem có bị sót hay không. Nếu không cần bạn hãy xóa cái dòng code này đi nhé.

els1 (cons (cons 62 3) els1) hoặc thêm vào phía trước dòng code dăm cái dấu ; bạn nhé.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123
Của bạn đây. Chúc bạn làm việc hiệu quả.

(defun c:ntext ()
 (setq ss (ssget "x" '((0 . "TEXT"))))
 (setq i 0)
 (setq lst (acet-ss-to-list ss))
 (while (    (setq name (nth i lst))
   (setq ent (entget name))
   (setq p1 (cdr (assoc 11 ent)))
   (setq nd1 (cdr (assoc 1 ent)))
   (foreach n lst
     (setq p2 (cdr (assoc 10 (entget n))))
     (setq nd2 (cdr (assoc 1 (entget n))))
     (if (equal p1 p2 0.01)
(progn
  (entmod (subst (cons 1 (strcat nd1 nd2)) (assoc 1 ent) ent))
  (entdel n)
  )
)
     )
   (setq i (1+ i))
   )
 )

Chào bác Phamngoctukts,

Sao bác không tách thành hai nhóm text cho đỡ công phải duyệt tất cả các text, nhất là khi bản vẽ lớn sẽ tốn khá nhiều thời gian.

Text của bác sau khi nối sẽ bị dịch chuyển vị trí so với ban đầu do cái mà dxf 72 của nó khác 0 bác ạ. Bác nên bổ xung một hàm subst nữa sẽ tốt hơn cho người dùng.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841
Lisp nối text của bạn đây:

(defun c:comtxt ( / ss1 ss2 p1 p2 t1 txt els1 els2 t2 )
(vl-load-com)
(alert "\nChon doi tuong can noi")
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 1 "*.")))))
(alert "\n Chon doi tuong noi")
(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 1 "##")))))
(command "undo" "be")
(foreach x ss1
      (setq els1 (entget x)
              p1 (cdr (assoc 10 els1))
              p2 (cdr (assoc 11 els1))
              t1 (cdr (assoc 1 els1))
              txt ""
      )
      (foreach y ss2
              (setq els2 (entget y)
                      t2 (cdr (assoc 1 els2))
              )
              (if (equal (cdr (assoc 10 els2)) p2 0.01)
                  (progn
                  (setq txt (strcat t1 t2))
                  (command "erase" y "")
                  )
              )
       )
       (if (/= txt "")
           (progn
                 (setq els1 (subst (cons 1 txt) (assoc 1 els1) els1)
                         els1 (subst (cons 72 0) (assoc 72 els1) els1)
                         els1 (cons (cons 62 3) els1)
                 )
                 (entmod els1)

          )
       )
)
(command "undo" "e")
(princ)
)

 

Chú ý: lisp này mình cho đổi màu các text đã được nối để bạn dễ kiểm tra xem có bị sót hay không. Nếu không cần bạn hãy xóa cái dòng code này đi nhé.

els1 (cons (cons 62 3) els1) hoặc thêm vào phía trước dòng code dăm cái dấu ; bạn nhé.

Chào bác Phamngoctukts,

Sao bác không tách thành hai nhóm text cho đỡ công phải duyệt tất cả các text, nhất là khi bản vẽ lớn sẽ tốn khá nhiều thời gian.

......

Thực ra chỉ cần chọn 1 nhóm text là đủ. Với mỗi phần tử trong nhóm Text được chọn đó,Lisp sẽ chọn anh text kế bên và "xử" luôn.

 

Làm theo cách của bạn Tú thì lâu, cách của bác Bình thì khá hơn vì mỗi một text phải duyệt qua toàn bộ text kế bên

và cách của Tue_NV là tốc độ nhanh nhất. :leluoi:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708
Thực ra chỉ cần chọn 1 nhóm text là đủ. Với mỗi phần tử trong nhóm Text được chọn đó,Lisp sẽ chọn anh text kế bên và "xử" luôn.

 

Làm theo cách của bạn Tú thì lâu, cách của bác Bình thì khá hơn vì mỗi một text phải duyệt qua toàn bộ text kế bên

và cách của Tue_NV là tốc độ nhanh nhất. he he :leluoi:

Hê hê đúng là cách của bác nhanh nhất. Bác đã dùng (ssget "x" ...) rồi còn dùng (alert ...) chi cho mệt.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841
Hê hê đúng là cách của bác nhanh nhất. Bác đã dùng (ssget "x" ...) rồi còn dùng (alert ...) chi cho mệt.

Không biết bạn Tú viết bài trả lời cho ai ấy nhỉ?

Trích dẫn bài viết của Tue_NV rồi trả lời cho bác Bình chăng?

 

Có lẽ giả nhời cho bác Bình rồi, vì bác Bình đã dùng cách mà bạn ấy viết ở trên, nhưng sao lại trích dẫn bài viết của Tue_NV rồi đi giả nhời cho bác Bình nhỉ?

Bạn Tú .... có vấn đề rồi :leluoi:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123
Thực ra chỉ cần chọn 1 nhóm text là đủ. Với mỗi phần tử trong nhóm Text được chọn đó,Lisp sẽ chọn anh text kế bên và "xử" luôn.

 

Làm theo cách của bạn Tú thì lâu, cách của bác Bình thì khá hơn vì mỗi một text phải duyệt qua toàn bộ text kế bên

và cách của Tue_NV là tốc độ nhanh nhất. :leluoi:

Hề hề hề,

Có phải ý bác như vầy không ạ:

(defun c:comtxt ( /  p1 p2 t1 txt els1 els2 t2  )
(vl-load-com)
;;;;;(alert "\nChon doi tuong can noi")
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 1 "*.")))))
;;;;;(alert "\n Chon doi tuong noi")
;;;;;(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 1 "##")))))
(command "undo" "be")
(foreach x ss1
      (setq els1 (entget x)
              p1 (cdr (assoc 10 els1))
              p2 (cdr (assoc 11 els1))
              t1 (cdr (assoc 1 els1))
              h (cdr (assoc 40 els1))
              txt ""
      )
      (acet-ss-zoom-extents ss1)
      (setq  ss2 (acet-ss-to-list (ssget "c" p1 (list (+ (car p2) 1) (+ (cadr p2) h) (caddr p2)) 
                                                            (list (cons 0 "text") (cons 1 "##")))))

      (foreach y ss2
              (setq els2 (entget y)
                      t2 (cdr (assoc 1 els2))
              )
              (if (equal (cdr (assoc 10 els2)) p2 0.01)
                  (progn
                  (setq txt (strcat t1 t2))
                  (command "erase" y "")
                  )
              )
       )
       (if (/= txt "")
           (progn
                 (setq els1 (subst (cons 1 txt) (assoc 1 els1) els1)
                         els1 (subst (cons 72 0) (assoc 72 els1) els1)
                         els1 (cons (cons 62 3) els1)
                 )
                 (entmod els1)

          )
       )
)
(command "undo" "e")
(princ)
)

 

PS: Đã nghe lời bác Phamngoctukts bỏ cái alert đi . Lúc trước do có hai lần chọn nên để vậy để nhắc nhở người dùng ấy mà.. Hề hề hề, cẩn tắc thêm áy náy các bác hỉ

 

@ Bãn Phamvanthiet108: Bạn có thể chơi cái mửng tắt béng cái layer "cao do nguyen " đi là mất hết các Acad_proxy_entity đó mà. Hơi củ chuối nhưng xài tạm cũng đỡ đói......

Chỉnh sửa theo phamthanhbinh

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708
Không biết bạn Tú viết bài trả lời cho ai ấy nhỉ?

Trích dẫn bài viết của Tue_NV rồi trả lời cho bác Bình chăng?

 

Có lẽ giả nhời cho bác Bình rồi, vì bác Bình đã dùng cách mà bạn ấy viết ở trên, nhưng sao lại trích dẫn bài viết của Tue_NV rồi đi giả nhời cho bác Bình nhỉ?

Bạn Tú .... có vấn đề rồi :cheers:

Híc híc nhầm tí mà Bác đã bảo em có vấn đề rôi. :leluoi:

BS: Mà dạo này thấy mình cũng đơ đơ thật. Tại nghiên cứu thêm cái thằng maxscript nên loạn hết cả lên.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708
Hề hề hề,

Có phải ý bác như vầy không ạ:

(defun c:comtxt ( /  p1 p2 t1 txt els1 els2 t2  )
(vl-load-com)
;;;;;(alert "\nChon doi tuong can noi")
(setq ss1 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 1 "*.")))))
;;;;;(alert "\n Chon doi tuong noi")
;;;;;(setq ss2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 1 "##")))))
(command "undo" "be")
(foreach x ss1
      (setq els1 (entget x)
              p1 (cdr (assoc 10 els1))
              p2 (cdr (assoc 11 els1))
              t1 (cdr (assoc 1 els1))
              h (cdr (assoc 40 els1))
              txt ""
             ss2 (acet-ss-to-list (ssget "c" p1 (list (+ (car p2) 1) (+ (cadr p2) h) (caddr p2)) 
                                                            (list (cons 0 "text") (cons 1 "##"))))
      )

      (foreach y ss2
              (setq els2 (entget y)
                      t2 (cdr (assoc 1 els2))
              )
              (if (equal (cdr (assoc 10 els2)) p2 0.01)
                  (progn
                  (setq txt (strcat t1 t2))
                  (command "erase" y "")
                  )
              )
       )
       (if (/= txt "")
           (progn
                 (setq els1 (subst (cons 1 txt) (assoc 1 els1) els1)
                         els1 (subst (cons 72 0) (assoc 72 els1) els1)
                         els1 (cons (cons 62 3) els1)
                 )
                 (entmod els1)

          )
       )
)
(command "undo" "e")
(princ)
)

 

PS: Đã nghe lời bác Phamngoctukts bỏ cái alert đi . Lúc trước do có hai lần chọn nên để vậy để nhắc nhở người dùng ấy mà.. Hề hề hề, cẩn tắc thêm áy náy các bác hỉ

 

@ Bãn Phamvanthiet108: Bạn có thể chơi cái mửng tắt béng cái layer "cao do nguyen " đi là mất hết các Acad_proxy_entity đó mà. Hơi củ chuối nhưng xài tạm cũng đỡ đói......

Bổ xung thêm ý của bác Tue_VN bác nên bổ xung thêm (acet-ss-zoom-extents ss1) vào nếu không cái (ssget "c" ....) của bác nó (tìm đâu cho thấy bóng em).

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
lacvanhoa    0

Cac bác ơi cho em hỏi một tý, sao em dung cái này trong cad 2007 không được vậy http://www.cadviet.com/upfiles/3/megashare...ritetoexcel.zip sau khi em NETLOAD xong em đánh lệnh toex thì cad báo (Exception has been throw by tayet an invocation) em ấn continue thì nó thoát lệnh luôn

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123
Bổ xung thêm ý của bác Tue_VN bác nên bổ xung thêm (acet-ss-zoom-extents ss1) vào nếu không cái (ssget "c" ....) của bác nó (tìm đâu cho thấy bóng em).

Chào bác Phamngoctukts,

Rất cám ơn bác đã góp ý để cho lisp hoàn thiện. Song mình thấy rằng có nhẽ không cần thêm hàm (acet-ss-zoom-extents ss1) vì cái hàm ssget đã được chỉ định rõ là chọn theo khung bao từ điểm p1 tới p2' rồi mà.

Cái hàm này theo mình hiểu là nó zoom bản vẽ về vùng chọn chứa các đối tượng thuộc tập chọn ss1. Nó là cần thiết trong một số trường hợp như khi sử dụng lệnh boundary chẳng hạn. Nhưng với hàm (ssget "c" .....) thì có nhẽ không cần vì mình đã chạy thử khi zoom bản vẽ về 1 góc nhỏ nó vẫn chạy phăm phăm và nối được hết tất cả các text, kể cả cái không nhòm thấy bác ạ.

 

@ Bác Tue_NV: Về sự góp ý của bác, mình cũng đã nhận ra, tuy nhiên có một vấn đề mà mình thấy hơi khó giải quyết là cái ký tự # nó chỉ thay thế cho 1 ký tự số, còn một nhóm số thì mình chưa biết xài kiểu chi. Vả lại theo mình thấy trên một số bản vẽ lại có ghi các text cao độ này kèm theo các ký tự khác đứng trước như +, -..... Vậy nên mình mới dùng ký tự * để thay thế cho một nhóm text nói chung mà không quan tâm tới số ký tự nữa.

Với trường hợp như bác đặt ra quả thật là nó sẽ chui vào tập chọn ss1, nếu nó tìm thấy bạn theo đúng yêu cầu thì nó sẽ kết dính ngay và như vậy thì sẽ khổ cho người sử dụng. Còn nếu nó không có bạn, lisp cũng sẽ vẫn chạy đến hết chứ không ăn vạ ở đó đâu bác ạ. Bởi vì khi đó biến txt sẽ là "" và lisp sẽ bỏ qua nó để chạy tiếp.

Tuy nhiên mình cho rằng việc nó tìm thấy bạn là khá hy hữu do cái điều kiện tìm bạn của nó cũng khá khó tính như bác đã thấy.

Để có thể loại trừ mọi khả năng thì thực ra mình cũng không thể loại trừ hết do mình là dân đi mót, amateur cả về chuyên môn của các bạn ấy và cả về lisp nữa, do vậy cái tầm nhìn bao quát khá kém, mình chỉ có thể căn cứ vào cái bản vẽ cụ thể của các bạn ấy gửi lên và giải quyết cho trường hợp cụ thể đó. Mọi thứ còn lại để làm cho hoàn chỉnh thì phải nhờ các bác giúp cho.

Theo mình nghĩ thì có thể kết hợp thêm một hay vài hàm if nữa để loại bớt mới có thể hoàn chỉnh được, nhưng cái chính là chưa biết đặt điều kiện ra sao bác ạ

Có thể dùng mã ascii cho từng ký tự trong chuỗi nhưng lại không biết số ký tự sẽ là bao nhiêu thì đủ bác à......

Cái này cũng giống như với tập chọn ss2 , mình mới chỉ lấy các text có hai chữ số, nhỡ bản vẽ có tới 3 hay 4 hay hơn nữa thì lisp lại cũng không đạt yêu cầu.

Để cho đúng với mọi trường hợp, mong các bác góp ý thêm.....

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708
Chào bác Phamngoctukts,

Rất cám ơn bác đã góp ý để cho lisp hoàn thiện. Song mình thấy rằng có nhẽ không cần thêm hàm (acet-ss-zoom-extents ss1) vì cái hàm ssget đã được chỉ định rõ là chọn theo khung bao từ điểm p1 tới p2' rồi mà.

Cái hàm này theo mình hiểu là nó zoom bản vẽ về vùng chọn chứa các đối tượng thuộc tập chọn ss1. Nó là cần thiết trong một số trường hợp như khi sử dụng lệnh boundary chẳng hạn. Nhưng với hàm (ssget "c" .....) thì có nhẽ không cần vì mình đã chạy thử khi zoom bản vẽ về 1 góc nhỏ nó vẫn chạy phăm phăm và nối được hết tất cả các text, kể cả cái không nhòm thấy bác ạ.

Chào bác Bình!

Em chưa chạy thử lisp của bác nhưng em test thử hàm ssget thì thấy như sau:

bác tạo 2 điểm p1 và p2 và vẽ một số đối tượng trong vùng cross p1 p2. Nếu các đối tượng không thấy trên màn hình thì (ssget "c" p1 p2) = nil.

Thế mà lisp của Bác vẫn chạy được thì quả là khó hiểu....

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123
Chào bác Bình!

Em chưa chạy thử lisp của bác nhưng em test thử hàm ssget thì thấy như sau:

bác tạo 2 điểm p1 và p2 và vẽ một số đối tượng trong vùng cross p1 p2. Nếu các đối tượng không thấy trên màn hình thì (ssget "c" p1 p2) = nil.

Thế mà lisp của Bác vẫn chạy được thì quả là khó hiểu....

Chào bác phamngoctukts,

Hề hề hề, xin lỗi bác nghen, do mình không kiểm tra kỹ, khi không zoom extend thì tuy lisp không chết đứng nhưng chỉ có các text thấy được trên màn hình là nối lại còn các text khác không thấy được sẽ không được nối. Do mình chạy không thấy lisp báo lỗi, tưởng là được tất mà không kiểm tra. Thấy bác nói mới làm lại và kéo màn hình ra mới thấy các text chưa được nối.

Thành thật xin lỗi bác và cũng cám ơn bác đã cho mình mót thêm được một bài bổ ích.

Mình sẽ bổ sung code của bác vào lisp trên ngay.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Test trong chính cái file mà bạn gửi lên đó. Bạn chú ý là xung quanh đối tượng mà bạn chọn không có đối tượng thừa nào. bạn thử move cái hình đó ra ngoài và dùng lisp xem.

Cảm ơn sự nhiệt tình của anh Tú. em dùng lisp trên chính file đó cũng được. em vẽ một hình khác kín hoàn toàn cũng không được.

Em upload lại file một lần nữa nhờ các Anh giúp đỡ.

Nội dụng: viết lisp vẽ một đường bao quanh theo viền của hình trong filemau.dwg

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

Cảm ơn anh

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
790312    4

Thí dụ mình có đoạ code tạo layer sau:

(defun taolayer ()
(if (= (tblsearch "layer" "thep") nil) (command "layer" "n" "thep" ""))
)

Vậy muốn cho layer thep này có độ dày là 0.5 và màu đỏ,linetype là "continuous" thì phải viết thêm code như thế nào?Mong được sự giúp đỡ của các bác.Thanks

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708
Thí dụ mình có đoạ code tạo layer sau:

(defun taolayer ()
(if (= (tblsearch "layer" "thep") nil) (command "layer" "n" "thep" ""))
)

Vậy muốn cho layer thep này có độ dày là 0.5 và màu đỏ,linetype là "continuous" thì phải viết thêm code như thế nào?Mong được sự giúp đỡ của các bác.Thanks

Muốn có layer như của bạn sửa như sau:

(if (= (tblsearch "layer" "thep") nil) (command "layer" "n" "thep" "lw" "0.5" "thep" "c" "1" "thep" "L" "Continuous" ""))

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
790312    4
Muốn có layer như của bạn sửa như sau:

(if (= (tblsearch "layer" "thep") nil) (command "layer" "n" "thep" "lw" "0.5" "thep" "c" "1" "thep" "L" "Continuous" ""))

Mình làm giống như bạn nhưng nó báo như sau:

Enter an option

[?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Fre

eze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: *Cancel*

Mong bạn chỉ giúp.Thanks.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708
Mình làm giống như bạn nhưng nó báo như sau:

Enter an option

[?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Fre

eze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: *Cancel*

Mong bạn chỉ giúp.Thanks.

Xin lỗi bạn còn thiếu cái "thep" (command "layer" "n" "thep" "lw" "0.5" "thep" "c" "1" "thep" "L" "Continuous" "thep" ""))

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708
Cảm ơn sự nhiệt tình của anh Tú. em dùng lisp trên chính file đó cũng được. em vẽ một hình khác kín hoàn toàn cũng không được.

Em upload lại file một lần nữa nhờ các Anh giúp đỡ.

Nội dụng: viết lisp vẽ một đường bao quanh theo viền của hình trong filemau.dwg

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

Cảm ơn anh

Bạn thử lại cái này xem sao:

;; free lisp from cadviet.com

(defun c:bao ()
(vl-load-com)
(setq ss (ssget))
(if (= (tblsearch "block" "b_temp") nil)
(command "block" "b_temp" "0,0" ss "")
(command "block" "b_temp" "y" "0,0" ss "")
)
(command "-insert" "b_temp" "0,0" "" "" "")
(setq rec (acet-ent-geomextents (setq el (entlast))))
(setq p1 (car rec))
(setq p2 (cadr rec))
(setq p1 (polar p1 (+ (/ pi 4) pi) 50))
(setq p2 (polar p2 (/ pi 4) 50))
(setq p (polar p1 (/ pi 4) 25))
(command "rectang" p1 p2)
(setq el1 (entlast))
(command "boundary" p ""
(if (/= (getvar "cmdactive") 0)
(alert "khong tao duoc duong bao ban hay kiem tra lai hinh ve")
)
)
(command "erase" el1 "")
(setq ss (ssget "w" p1 p2 (list (cons 0 "LWPOLYLINE"))))
(command "change" ss "" "p" "c" "2" "")
(setq ss (acet-ss-to-list ss))
(setq lar (list))
(foreach n ss
(setq dt (dientich n))
(setq lar (append (list (list dt n)) lar))
)
(setq lar (vl-sort lar '(lambda (x y)
(> (car x) (car y))
)
)
)
(setq rm (cadr (cadr lar)))
(Setq ss (vl-remove rm ss))
(setq ss (acet-list-to-ss ss))
(command "erase" ss "")
(acet-explode el)
)
(defun dientich (name / are ob ll)
(command "region" name "")
(setq ob (vlax-ename->vla-object (setq ll (entlast))))
(setq are (vla-get-area ob))
(command "undo" 1)
are
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thaistreetz    515
Xin lỗi bạn còn thiếu cái "thep" (command "layer" "n" "thep" "lw" "0.5" "thep" "c" "1" "thep" "L" "Continuous" "thep" ""))

Các bạn nên xây dựng các hàm tạo đối tuợng như thế này để tránh những rắc rối mà hàm command tạo ra.

(defun MakeLayer (name color linetype lineWeight plot xdata)
(entmake (list '(0 . "LAYER")
	 (cons 100 "AcDbSymbolTableRecord")
	 (cons 100 "AcDbLayerTableRecord")
	 (cons 2 name)
	 (cons 70 0)
	 (cons 62 (if color color 7))
	 (cons 6 (if linetype linetype "Continuous"))
	 (cons 290 (if plot 1 0))
	 (cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))
	 (cons -3 (if xdata (list xdata) nil))))
(tblobjname "layer" name))

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamngoctukts    708
Các bạn nên xây dựng các hàm tạo đối tuợng như thế này để tránh những rắc rối mà hàm command tạo ra.

(defun MakeLayer (name color linetype lineWeight plot xdata)
(entmake (list '(0 . "LAYER")
	 (cons 100 "AcDbSymbolTableRecord")
	 (cons 100 "AcDbLayerTableRecord")
	 (cons 2 name)
	 (cons 70 0)
	 (cons 62 (if color color 7))
	 (cons 6 (if linetype linetype "Continuous"))
	 (cons 290 (if plot 1 0))
	 (cons 370 (if lineWeight (fix (* 100 lineWeight)) -3))
	 (cons -3 (if xdata (list xdata) nil))))
(tblobjname "layer" name))

Thank bạn! Nhưng với nhiều đối tượng phức tạp thì dùng command để tạo đối tượng mình thấy ngắn hơn. Với lại các thông số dxf để tạo đối tượng cần bao nhiêu thì đủ và dùng những mã nào mình cũng không nắm rõ. Ví dụ như tạo text mình dùng các mã 0, 1, 10, 40, 72 để taok mà nó không ra.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thaistreetz    515
Thank bạn! Nhưng với nhiều đối tượng phức tạp thì dùng command để tạo đối tượng mình thấy ngắn hơn. Với lại các thông số dxf để tạo đối tượng cần bao nhiêu thì đủ và dùng những mã nào mình cũng không nắm rõ. Ví dụ như tạo text mình dùng các mã 0, 1, 10, 40, 72 để taok mà nó không ra.

Vẽ đối tượng bằng hàm command luôn phải chịu ảnh hưởng rất nhiều từ các biến hệ thống. Biến osmode là ví dụ điển hình. thêm nữa là hàm command tạo đối tượng tương đối chậm, và nếu với 1 lisp tạo ra 1 số lượng lớn đối tượng từ hàm command, khi undo lại thì ngồi chờ cổ dài bằng hươu luôn. <_<

Với text thì bạn sử dụng hàm này.

(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
(setq Lst (list '(0 . "TEXT")
								(cons 8 (if Layer Layer (getvar "Clayer")))
								(cons 62 (if Color Color 256))
								(cons 10 point)
								(cons 40 Height)
								(cons 1 string)
								(cons 50 (if Ang (* pi (/ Ang 180)) 0))
								(cons 7 (if Style Style (getvar "Textstyle")))
								(cons -3 (if xdata (list xdata) nil)))
			justify (strcase justify))
(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
			((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
			((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
			((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
			((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
			((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
			((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
			((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
			((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
			((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
			((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
			((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1))))))
(entmake Lst)
(entlast))

PS: ngắn hay dài, điều đó tùy vào nhu cầu và thói quen của từng người khi viết code thôi. chẳng hạn với code trên, với nhu cầu thông thường thì có thể rút ngắn số lượng biến của nó còn lại 3 biến: point, string, và height

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841
Thank bạn! Nhưng với nhiều đối tượng phức tạp thì dùng command để tạo đối tượng mình thấy ngắn hơn. Với lại các thông số dxf để tạo đối tượng cần bao nhiêu thì đủ và dùng những mã nào mình cũng không nắm rõ. Ví dụ như tạo text mình dùng các mã 0, 1, 10, 40, 72 để taok mà nó không ra.

Thường phải có thêm Dxf =11 nữa.

Bạn cứ tạo xem. Nếu không được, post lên đây để anh chị em giúp đỡ

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thank bạn! Nhưng với nhiều đối tượng phức tạp thì dùng command để tạo đối tượng mình thấy ngắn hơn. Với lại các thông số dxf để tạo đối tượng cần bao nhiêu thì đủ và dùng những mã nào mình cũng không nắm rõ. Ví dụ như tạo text mình dùng các mã 0, 1, 10, 40, 72 để taok mà nó không ra.

Bạn cũng có thể mò như sau:

- Dùng Entget để lấy dữ liệu của dối tượng TEXT (là 1 LIST)

- Dùng Entmake để tạo đối tượng ứng với LIST đó

- lược bỏ dần những list con không cần thiết bằng cách xóa list con đó mà vẫn tạo được text.

- Cứ như vậy Bạn sẽ có 1 danh sách tối thiểu để tạo TEXT.

 

(Có thể tương ứng với từng máy. Như máy Mình đang dùng thì chỉ cần 0 10 40 1. Bạn chú ý hình như phải sắp đặt theo thứ tự cái trước cái sau, ví dụ 0 phải là đầu tiên

- (entmake (list (cons 0 "TEXT")(cons 10 (list 100 100))(cons 40 1.2)(cons 1 "Ví dụ 1"))) được

- (entmake (list (cons 40 1.2) (cons 0 "TEXT") (cons 10 (list 100 100))(cons 1 "Ví dụ 2"))) không được

)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
lacvanhoa    0

các bác biết chỉ dùm mình với sau mình sử dụng ỨNG DỤNG CỦA AUTOCAD.NET API cho phép trích xuất text trong bản vẽ ra file exel tren cad 2007 không được vậy http://www.cadviet.com/upfiles/3/megashare...tetoexcel_1.zip

Sao không ai chịu giúp mình hết vậy, thật là buồn quá đi hu hu hu

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×