Chuyển đến nội dung
Diễn đàn CADViet
lucton

Viết VBA theo yêu cầu.............

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

Xin mọi người giúp đỡ. Mình có 1 VBA khi chạy cad báo lỗi như hình sau:http://www.cadviet.com/upfiles/1_14.bmp.

và đây là file VBA:http://www.cadviet.com/upfiles/Copy.vbs. Nhờ mọi người giúp đỡ.

 

Thông báo tiếng Tàu hay Nhật gì đó, lỗi này có thể do thiếu tham chiếu đến đối tượng (nhìn một số lệnh lạ lạ)

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

Nhờ các ace giúp em cái này...e có 1 file cad 2D, gồm các các điểm, lân cận điểm có các text thể hiện thông tin của điểm như số thứ tự, cao độ của điểm (xem file đính kèm : http://www.cadviet.com/upfiles/Drawing1_45.dwg ). Vấn đề của em là bây giờ e muốn viết 1 code để sao có thể xuất hết các thông tin này thành 1 file excel hay text với định dạng:

stt toadox toadoy docao

 

cụ thể áp dụng cho file này :

1 8.7320 11.8432 0.02

2 18.4642 20.9190 0.10

3 37.6395 19.6864 0.02

4 43.8070 11.0028 1.25

5 27.6033 4.2800 -1.20

 

Nếu file này là file 3D thì không thành vấn đề rồi, ngặc nỗi là 2D, và cái cao độ là 1 đối tượng text riêng lẽ, e không biết làm như thế nào cả. ACE nào có thể giúp e cái code hay hướng dẫn cách giải quyết thì chỉ em cũng được, em từ từ làm. Hiện nay hướng giải quyết của em là chuyển sang file dxf, vì nghe nói dxf có thể truy xuất được thông tin với dạng text file, e tính tìm vị trí các điểm và các text cao độ trong text file của dxf, sau đó tìm cách gắn cao độ tương ứng với vị trí của điểm. nhưng thấy tương lai mù mịt quá...heheheh...đó là suy nghĩ giải fáp của em vì đến giờ cũng không biết làm sao nhận biết thông tin tọa độ trong file text của dxf.

Em cám ơn nhiề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
Nhờ các ace giúp em cái này...e có 1 file cad 2D, gồm các các điểm, lân cận điểm có các text thể hiện thông tin của điểm như số thứ tự, cao độ của điểm (xem file đính kèm : http://www.cadviet.com/upfiles/Drawing1_45.dwg ). Vấn đề của em là bây giờ e muốn viết 1 code để sao có thể xuất hết các thông tin này thành 1 file excel hay text với định dạng:

stt toadox toadoy docao

 

Nếu file này là file 3D thì không thành vấn đề rồi, ngặc nỗi là 2D, và cái cao độ là 1 đối tượng text riêng lẽ, e không biết làm như thế nào cả. ACE nào có thể giúp e cái code hay hướng dẫn cách giải quyết thì chỉ em cũng được, em từ từ làm. Hiện nay hướng giải quyết của em là chuyển sang file dxf, vì nghe nói dxf có thể truy xuất được thông tin với dạng text file, e tính tìm vị trí các điểm và các text cao độ trong text file của dxf, sau đó tìm cách gắn cao độ tương ứng với vị trí của điểm. nhưng thấy tương lai mù mịt quá...heheheh...đó là suy nghĩ giải fáp của em vì đến giờ cũng không biết làm sao nhận biết thông tin tọa độ trong file text của dxf.

Em cám ơn nhiều...

 

Vì đây là chuyên mục về vba nên mình cũng xin phép trước, vì mình không rành về vba nhưng nếu bạn dùng lisp thì mình đề nghị lisp này, kết quả ra cũng đúng ý bạn. File kết quả là file output.txt nằm trong cùng thư mục với bản vẽ của bạn.

 
(defun c:ltt()
 (setq ss (ssget "X" '((0 . "Point")))
file (open "output.txt" "w")
L nil)
 (repeat (sslength ss)
(setq ent (ssname ss 0)
  tt10 (cdr (assoc 10 (entget ent)))
  ss1 (ssget "c" (polar (polar tt10 0 2.5) (/ pi 2) -2.5)
		 (polar (polar tt10 0 -2.5) (/ pi 2) 2.5) '((0 . "TEXT")))
)
(repeat (sslength ss1)
  (setq ent1 (ssname ss1 0)
	tt1 (cdr (assoc 1 (entget ent1))))
  (if (vl-string-search "." tt1)
(setq docao tt1)
(setq stt tt1))
  (ssdel ent1 ss1)
)
(setq L (cons (cons stt (list (strcat stt " " (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao))) L))
(ssdel ent ss)	  
 )
 (setq L (vl-sort L '(lambda(v1 v2) (< (car v1) (car v2)))))
 (foreach v L (write-line (cadr v) file))
 (close file)
)

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

Hic...Lisp thì e chẳng biết gì...e chỉ biết VBA thui, đọc vào chẳng hiểu gì nhưng dù sao e cũng cám ơn a đã viết. Nhưng cho e hỏi gõ lệnh gì để chạy ? Em load lên rồi. em gõ ltt nhưng chẳng được, nó báo "ltt nil"...

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
Hic...Lisp thì e chẳng biết gì...e chỉ biết VBA thui, đọc vào chẳng hiểu gì nhưng dù sao e cũng cám ơn a đã viết. Nhưng cho e hỏi gõ lệnh gì để chạy ? Em load lên rồi. em gõ ltt nhưng chẳng được, nó báo "ltt nil"...

 

trình tự test:

- mở file bản vẽ cảu bạn.

- gõ ap , chọn đg dẫn đến file có chứa lệnh ltt. Xem load có thành công ko (successfully loaded).

- gõ ltt.

 

ltt nil là CT đã chạy xong rồi đó, kiểm tra xem có file output.txt trong cùng thư mục có bản vẽ (nếu khi mở bản vẽ bạn nhấp đúp vảo tên file)

hoặc ở thư mục gốc của cad (Autocad 200X) của bạn nếu bạn nhấp đúp acad.exe.

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
trình tự test:

- mở file bản vẽ cảu bạn.

- gõ ap , chọn đg dẫn đến file có chứa lệnh ltt. Xem load có thành công ko (successfully loaded).

- gõ ltt.

 

ltt nil là CT đã chạy xong rồi đó, kiểm tra xem có file output.txt trong cùng thư mục có bản vẽ (nếu khi mở bản vẽ bạn nhấp đúp vảo tên file)

hoặc ở thư mục gốc của cad (Autocad 200X) của bạn nếu bạn nhấp đúp acad.exe.

Em không để ý nên không biết, tại lisp chạy xong chẳng thấy báo gì ..heheh..., kiểm tra thì nó nằm ngay thư mục bản vẽ

Anh ơi, giờ e bỏ không dùng stt nữa, vì xuất sang bình đồ thì stt không còn ý nghĩa, a có thể sửa lại dùm em chỉ có toadox toadoy caodo thôi được không ? Cám ơn anh nhiề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
Em không để ý nên không biết, tại lisp chạy xong chẳng thấy báo gì ..heheh..., kiểm tra thì nó nằm ngay thư mục bản vẽ

Anh ơi, giờ e bỏ không dùng stt nữa, vì xuất sang bình đồ thì stt không còn ý nghĩa, a có thể sửa lại dùm em chỉ có toadox toadoy caodo thôi được không ? Cám ơn anh nhiều...

Tức là trong file output.txt ko có stt 1,2,3,4... nữa hay là trong bản vẽ ko có text 1,2,3,4... nữa? 2 cái viết khác nhau.

Nếu chỉ là xoá stt trtong file output.txt thì sửa lại như sau:

(defun c:ltt()
 (setq ss (ssget "X" '((0 . "Point")))
file (open "output.txt" "w")
L nil)
 (while (and ss (> (sslength ss) 0))
   (setq ent (ssname ss 0)
  tt10 (cdr (assoc 10 (entget ent)))
  ss1 (ssget "c" (polar (polar tt10 0 2.5) (/ pi 2) -2.5)
	     (polar (polar tt10 0 -2.5) (/ pi 2) 2.5) '((0 . "TEXT")))
   )
   (while (and ss1 (> (sslength ss1) 0))
     (setq ent1 (ssname ss1 0)
    tt1 (cdr (assoc 1 (entget ent1))))
     (if (vl-string-search "." tt1)
(setq docao tt1)
(setq stt tt1))
     (ssdel ent1 ss1)
   )
   (if (and stt docao)
     (setq L (cons (cons stt (list (strcat (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao))) L))
   )
   (ssdel ent ss)	  
 )
 (if L
   (progn
     (setq L (vl-sort L '(lambda(v1 v2) (< (car v1) (car v2)))))
     (foreach v L (write-line (cadr v) file))
   ))
 (close file)
)

  • 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
Nhờ các ace giúp em cái này...e có 1 file cad 2D, gồm các các điểm, lân cận điểm có các text thể hiện thông tin của điểm như số thứ tự, cao độ của điểm (xem file đính kèm : http://www.cadviet.com/upfiles/Drawing1_45.dwg ). Vấn đề của em là bây giờ e muốn viết 1 code để sao có thể xuất hết các thông tin này thành 1 file excel hay text với định dạng:

stt toadox toadoy docao

 

cụ thể áp dụng cho file này :

1 8.7320 11.8432 0.02

2 18.4642 20.9190 0.10

3 37.6395 19.6864 0.02

4 43.8070 11.0028 1.25

5 27.6033 4.2800 -1.20

 

Nếu file này là file 3D thì không thành vấn đề rồi, ngặc nỗi là 2D, và cái cao độ là 1 đối tượng text riêng lẽ, e không biết làm như thế nào cả. ACE nào có thể giúp e cái code hay hướng dẫn cách giải quyết thì chỉ em cũng được, em từ từ làm. Hiện nay hướng giải quyết của em là chuyển sang file dxf, vì nghe nói dxf có thể truy xuất được thông tin với dạng text file, e tính tìm vị trí các điểm và các text cao độ trong text file của dxf, sau đó tìm cách gắn cao độ tương ứng với vị trí của điểm. nhưng thấy tương lai mù mịt quá...heheheh...đó là suy nghĩ giải fáp của em vì đến giờ cũng không biết làm sao nhận biết thông tin tọa độ trong file text của dxf.

Em cám ơn nhiều...

Đây là 1 phần file dxf

File gồm nhiều dòng xen kẽ là mã dxf và giá trị

Đối với POINT cần lấy tọa độ là giá trị dxf của 10, 20, 30

Đối với TEXT cần lấy string là giá trị dxf của 1. Tọa độ là giá trị dxf của 10, 20, 30

.............

0

SECTION : Bắt đầu SECTION

2

ENTITIES : ENTITIES SECTION

0 : Bắt đầu 1 đối tượng

POINT : Loại đối tượng

5

89

330

1F

100

AcDbEntity

8

0

100

AcDbPoint

10 : mã DXF

8.371965187842675 : x

20 : mã DXF

11.84315607829592 : y

30 : mã DXF

0.0 : z

0 : Bắt đầu 1 đối tượng khác

POINT : Loại đối tượng

............

0 : Bắt đầu đối tượng khác

TEXT : Loại đối tượng

5

8E

330

1F

100

AcDbEntity

8

0

100

AcDbText

10

8.736884151323664

20

8.879625957684513

30

0.0

40

1.948780353759978

1 : mã DXF

0.02 : string

100

AcDbText

0 : Bắt đầu đối tượng khác

TEXT : Loại đối tượng

........

Cách này làm dài dòng vì phải đọc thông tin toàn bộ point và phải tự tìm các text tương ứng.

Thuật toán này có độ phức tạp bậc 2 nên không nên dùng cho file có nhiều điểm.

 

Nếu bạn muốn dùng VBA thì vì không có thời gian nên tôi chỉ hướng dẫn.

Thuật toán tương tự như lisp của bạn q288

- Select toàn bộ điểm trong bản vẽ

- Tìm text thứ tự và độ cao tương ứng của điểm bằng cửa sổ

Chú ý:

1. trong lisp chưa xử lý trường hợp lỗi nếu selection set có số text khác 2

2. Nếu các đối tượng nằm ngoài màn hình thì sẽ không chọn được

Trong trường hợp này phải zoom extend và cho OSMODE=0

- Xuất ra file.

Vì VBA không có nhiều hàm thư viện nên bạn cho kết qủa vào excel để sort

 

Đơn giản nhất là dùng lisp của bạn q288 nhưng chú ý 2 trường hợp trên.

Ngoài ra trong lisp còn 1 lỗi là phải thay dòng:

(setq L (cons (cons stt (list (strcat stt " " (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao))) L))

Bằng dòng:

(setq L (cons (cons (atoi stt) (list (strcat stt " " (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao)))

 

L))

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
Ngoài ra trong lisp còn 1 lỗi là phải thay dòng:

(setq L (cons (cons stt (list (strcat stt " " (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao))) L))

Bằng dòng:

(setq L (cons (cons (atoi stt) (list (strcat stt " " (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao)))

 

L))

 

stt hay (atoi stt) ko quan trọng vì khi vl-sort có thể sort cả string mà. Bằng chứng là Ct vẫn cho ra kết quả đú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
Tức là trong file output.txt ko có stt 1,2,3,4... nữa hay là trong bản vẽ ko có text 1,2,3,4... nữa? 2 cái viết khác nhau.

Nếu chỉ là xoá stt trtong file output.txt thì sửa lại như sau:

(defun c:ltt()
 (setq ss (ssget "X" '((0 . "Point")))
file (open "output.txt" "w")
L nil)
 (while (and ss (> (sslength ss) 0))
   (setq ent (ssname ss 0)
  tt10 (cdr (assoc 10 (entget ent)))
  ss1 (ssget "c" (polar (polar tt10 0 2.5) (/ pi 2) -2.5)
	     (polar (polar tt10 0 -2.5) (/ pi 2) 2.5) '((0 . "TEXT")))
   )
   (while (and ss1 (> (sslength ss1) 0))
     (setq ent1 (ssname ss1 0)
    tt1 (cdr (assoc 1 (entget ent1))))
     (if (vl-string-search "." tt1)
(setq docao tt1)
(setq stt tt1))
     (ssdel ent1 ss1)
   )
   (if (and stt docao)
     (setq L (cons (cons stt (list (strcat (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao))) L))
   )
   (ssdel ent ss)	  
 )
 (if L
   (progn
     (setq L (vl-sort L '(lambda(v1 v2) (< (car v1) (car v2)))))
     (foreach v L (write-line (cadr v) file))
   ))
 (close file)
)

 

a thêm dùm em trường hợp trên bản vẽ không có stt đi, vì có thể e sẽ tắt lớp này đi cho đỡ rối bản vẽ. E sẽ thử test trên bản vẽ thực tế ntn vì file sample e đưa ra chỉ có vài điểm...còn thực tế thì nó có đến cả ngàn điể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
stt hay (atoi stt) ko quan trọng vì khi vl-sort có thể sort cả string mà. Bằng chứng là Ct vẫn cho ra kết quả đúng.

2<10 nhưng nếu so sánh string thì "2" > "10"

Vì vậy nếu trong bản vẽ có stt >10 sẽ cho ra kết quả sai mặc không quan trọng vì có thể sort lại bên ngoài.

Nhưng nếu lấy kết quả trên mà vẽ trong CAD thì không ổ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
2<10 nhưng nếu so sánh string thì "2" > "10"

Vì vậy nếu trong bản vẽ có stt >10 sẽ cho ra kết quả sai mặc không quan trọng vì có thể sort lại bên ngoài.

Nhưng nếu lấy kết quả trên mà vẽ trong CAD thì không ổn

 

OK, bạn nói đúng, mình quên vì file mẫu chỉ có 5 point thôi nên ko nghĩ tới chuyện đó. Mình sửa lại theo ý của bạn và của bạn se7en luôn (tắt lớp stt) như sau:

file output.txt sẽ nằm ở d:/ cho tiện viẹc tìm kiếm.

 

(defun c:ltt()
 (command "zoom" "e")
 (setq ss (ssget "X" '((0 . "Point")))
file (open "d:/output.txt" "w")
L nil
os (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (while (and ss (> (sslength ss) 0))
   (setq ent (ssname ss 0)
  tt10 (cdr (assoc 10 (entget ent)))
  ss1 (ssget "c" (polar (polar tt10 0 2.5) (/ pi 2) -2.5)
	     (polar (polar tt10 0 -2.5) (/ pi 2) 2.5) '((0 . "TEXT"))
  docao nil)
   )

   (while (and ss1 (> (sslength ss1) 0))
     (setq ent1 (ssname ss1 0)
    tt1 (cdr (assoc 1 (entget ent1))))
     (if (vl-string-search "." tt1)
(setq docao tt1))
     (ssdel ent1 ss1)
   )

   (if docao
     (setq L (append L (list (strcat (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao)))))
   (ssdel ent ss)	  
 )
 (if L (foreach v L (write-line v file)))
 (close file)
 (setvar "OSMODE" os)
)

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

Mod đâu hết rồi, đây là chuyên mục VB mà, mấy cái VD này mà dùng Lsp thì chán chết.

 

VB xài dễ vô cùng, nhìn mấy cái ngoặc rối quá.

  • Vote giảm 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
Mod đâu hết rồi, đây là chuyên mục VB mà, mấy cái VD này mà dùng Lsp thì chán chết.

 

VB xài dễ vô cùng, nhìn mấy cái ngoặc rối quá.

 

Biết là chuyên mục VB nên mình có xin phép trước khi đưa lisp lên. Nếu Mod thấy ko tiện thì xóa đi cũng ko sao.

VB dễ xài thì bạn post CT dùng VB để giải quyết vấn đề của bạn se7en xem sao.

  • 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
Nhờ các ace giúp em cái này...e có 1 file cad 2D, gồm các các điểm, lân cận điểm có các text thể hiện thông tin của điểm như số thứ tự, cao độ của điểm (xem file đính kèm : http://www.cadviet.com/upfiles/Drawing1_45.dwg ). Vấn đề của em là bây giờ e muốn viết 1 code để sao có thể xuất hết các thông tin này thành 1 file excel hay text với định dạng:

stt toadox toadoy docao

 

cụ thể áp dụng cho file này :

1 8.7320 11.8432 0.02

2 18.4642 20.9190 0.10

3 37.6395 19.6864 0.02

4 43.8070 11.0028 1.25

5 27.6033 4.2800 -1.20

 

Nếu file này là file 3D thì không thành vấn đề rồi, ngặc nỗi là 2D, và cái cao độ là 1 đối tượng text riêng lẽ, e không biết làm như thế nào cả. ACE nào có thể giúp e cái code hay hướng dẫn cách giải quyết thì chỉ em cũng được, em từ từ làm. Hiện nay hướng giải quyết của em là chuyển sang file dxf, vì nghe nói dxf có thể truy xuất được thông tin với dạng text file, e tính tìm vị trí các điểm và các text cao độ trong text file của dxf, sau đó tìm cách gắn cao độ tương ứng với vị trí của điểm. nhưng thấy tương lai mù mịt quá...heheheh...đó là suy nghĩ giải fáp của em vì đến giờ cũng không biết làm sao nhận biết thông tin tọa độ trong file text của dxf.

Em cám ơn nhiều...

 

Cách thức xử lý:

Chọn tất cả các điểm, sau đó chọn tiếp tất cả các text liên quan.

Ứng với mỗi điểm, ta sẽ tìm 2 text gần nó nhất, một cái là stt, cái còn lại là cao độ.

 

Cuối cùng xuất ra file Excel theo thứ tự như trên stt X Y Z

 

 

Bản vẽ mẫu của bạn [có thể] không được rõ ràng lắm, nên copy một phần của bản vẽ thật để dễ đối chứng hơn.

Trong trường hợp khoảng cách giữa 2 điểm nhỏ hơn khoảng cách giữa điểm và text caođộ/stt thì thuật toán trên không làm việc chính xác.

 

Sẽ có chương trình trong vài giờ nữa.

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
Nhờ các ace giúp em cái này...e có 1 file cad 2D, gồm các các điểm, lân cận điểm có các text thể hiện thông tin của điểm như số thứ tự, cao độ của điểm (xem file đính kèm : http://www.cadviet.com/upfiles/Drawing1_45.dwg ). Vấn đề của em là bây giờ e muốn viết 1 code để sao có thể xuất hết các thông tin này thành 1 file excel hay text với định dạng:

stt toadox toadoy docao

 

cụ thể áp dụng cho file này :

1 8.7320 11.8432 0.02

2 18.4642 20.9190 0.10

3 37.6395 19.6864 0.02

4 43.8070 11.0028 1.25

5 27.6033 4.2800 -1.20

 

Nếu file này là file 3D thì không thành vấn đề rồi, ngặc nỗi là 2D, và cái cao độ là 1 đối tượng text riêng lẽ, e không biết làm như thế nào cả. ACE nào có thể giúp e cái code hay hướng dẫn cách giải quyết thì chỉ em cũng được, em từ từ làm. Hiện nay hướng giải quyết của em là chuyển sang file dxf, vì nghe nói dxf có thể truy xuất được thông tin với dạng text file, e tính tìm vị trí các điểm và các text cao độ trong text file của dxf, sau đó tìm cách gắn cao độ tương ứng với vị trí của điểm. nhưng thấy tương lai mù mịt quá...heheheh...đó là suy nghĩ giải fáp của em vì đến giờ cũng không biết làm sao nhận biết thông tin tọa độ trong file text của dxf.

 

 

coverulv.jpg

 

 

Link đây http://www.mediafire.com/file/imtgyynt2mw/...pSTT_X_Y_EL.exe

 

 

Tạo lại bản vẽ mới sẽ tạo các 3D text có toạ độ và nội dung là STT. Zoom All để xem.

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
báo lỗi như hình bạn ơi...

bạn có thể post code lên để mình tham khảo được không ? chứ file exe thì khó tìm hiểu quá...

http://www.cadviet.com/upfiles/untitled_28.jpg

 

Cái này cần fải cài .NET framework 2.0 trên máy tính.

 

Mình chỉ đưa thuật toán chứ code thì lằng nhằng lắ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
Cái này cần fải cài .NET framework 2.0 trên máy tính.

 

Mình chỉ đưa thuật toán chứ code thì lằng nhằng lắm.

 

Tưởng bạn đưa file nguồn lên chứ đưa file exe thì làm sao chứng minh được là VB "xài dễ vô cùng" được, mà nói

dễ xài mà lại "lằng nhằng" là sao?

Nếu bạn là cao thủ VBA thì nên post bài nhiều nhiều và đưa code lên để anh em còn

học hỏi nữa 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
Tưởng bạn đưa file nguồn lên chứ đưa file exe thì làm sao chứng minh được là VB "xài dễ vô cùng" được, mà nói

dễ xài mà lại "lằng nhằng" là sao?

Nếu bạn là cao thủ VBA thì nên post bài nhiều nhiều và đưa code lên để anh em còn

học hỏi nữa nhé.

 

Không fải là không muốn đưa code, mà do dùng thêm các thư viện riêng nên rất dài dòng.

 

- Các biến chung

Structure TPoint'Lưu thông tin của điểm
	 Dim Pos As PointF
	 Dim EL As Single
	 Dim No As String
End Structure
Dim Points() As TPoint

'Khai báo biến không tường minh
'cho nên có thể làm việc với các loại version của AutoCAD
 Dim PointSelSet As Object'tập chọn điểm
Dim TextSelSet As Object'tập chọn Text

Dim Points_Selected As Boolean = False  
Dim Texts_Selected As Boolean = False

 

- Chọn các điểm từ màn hình CAD

Private Sub cmdSelPoint_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSelPoint.Click
		   If acAutoCAD_Link() Then 'Nếu CAD đang chạy và rảnh rỗi
			   'Dùng bộ lọc điểm
			   Dim ens() As String = {"POINT"}
			   Dim Data() As Object, Type() As Short

			   'Tạo bộ lọc và tập chọn đối tượng
			   acCreateFilter(ens, Type, Data) 'hàm tự làm
			   PointSelSet = acCreateSelectionSet("anhcos points")'hàm tự làm

			   'Active cửa sổ ACAD
			   AppActivate(Acad.Caption)

			   'Chọn các đối tượng điểm trên màn hình
			   PointSelSet.Clear()
			   PointSelSet.SelectOnScreen(Type, Data)

			   Points_Selected = PointSelSet.Count > 0

 'Nếu đã chọn điểm và Text thì tiến hành tính toán
			   If Points_Selected And Texts_Selected Then
				   PointProcess() 'Tính toán ra dữ liệu của các điểm
				   End If

			   AppActivate(Me.Text) 'trở về chương trình sau khi chọn
		   End if
   End Sub

 

- Chọn các TEXT từ màn hình CAD (là STT và EL)

 If acAutoCAD_Link() Then 'Nếu CAD đang chạy và rảnh rỗi
		   'Bộ lọc Text và MText
		   Dim ens() As String = {"TEXT", "MTEXT"}
		   Dim Data() As Object, Type() As Short

		   'Tạo bộ lọc đối tượng và tập chọn
		   acCreateFilter(ens, Type, Data)'hàm tự làm
		   TextSelSet = acCreateSelectionSet("anhcos Texts")'hàm tự làm

		   'Active cửa sổ ACAD
		   AppActivate(Acad.Caption)

		   'Chọn các đối tượng text và Mtext
		   TextSelSet.Clear()
		   TextSelSet.SelectOnScreen(Type, Data)

		   Texts_Selected = TextSelSet.Count > 0		 

		   'Nếu đã chọn điểm và Text thì tiến hành tính toán
		   If Points_Selected And Texts_Selected Then
			   PointProcess()				
		   End If

		   'Trở về chương trình
		   AppActivate(Me.Text)		 
	   End If
   End Sub

 

- Phần xử lý tìm ra liên kết giữa điểm và STT, EL

 Sub PointProcess()
	 Dim i, j As Integer
	 Dim ndPoint_variant As Object

	 Try
		 'Khởi tạo mảng lưu thôg tin các điểm
		 ReDim Points(PointSelSet.Count - 1)

		 'Gán X và Y vào trước từ toạ độ của điểm
		 For i = 0 To PointSelSet.Count - 1
			 Points(i).Pos.X = PointSelSet.Item(i).Coordinates(0)
			 Points(i).Pos.Y = PointSelSet.Item(i).Coordinates(1)
		 Next i

		 'Lưu toạ độ của Text để tăng tốc độ vì không fải truy xuất trực tiếp đến dữ liệu của CAD
		 Dim TextPos(TextSelSet.Count - 1) As PointF
		 For i = 0 To TextSelSet.Count - 1
			 'điểm chèn của Text
			 ndPoint_variant = TextSelSet.Item(i).InsertionPoint

			 'Lưu vị trí vào mảng vị trí
			 TextPos(i).X = ndPoint_variant(0)
			 TextPos(i).Y = ndPoint_variant(1)
		 Next i

		 'khoảng cách gần nhất và gần nhì đến điểm
		 Dim stMinDist As Single, ndMinDist As Single, Dist As Single
		 Dim stMinIndex, ndMinIndex As Integer

		 'Tìm STT và EL
		 For i = 0 To PointSelSet.Count - 1 'Duyệt qua từng điểm trong tập chọn điểm
			 stMinDist = 1000000000
			 ndMinDist = 1000000000
			 stMinIndex = -1
			 ndMinIndex = -1

			 For j = 0 To TextSelSet.count - 1 'Duyệt qua tất cả các Text trong tập chọn
				 Dist = CalDist(Points(i).Pos, TextPos(j)) 'Tính khoảng cách đến nó

				 'Xác định khoảng cách nhỏ nhất và nhỏ nhì
				 If stMinDist > Dist Then
					 stMinDist = Dist
					 stMinIndex = j
				 Else
					 If ndMinDist > Dist Then
						 ndMinDist = Dist
						 ndMinIndex = j
					 End If
				 End If
			 Next j

			 Try
				 'Vì Y của Text nhỏ hơn Y của điểm --> là STT
				 If TextPos(stMinIndex).Y > Points(i).Pos.Y Then
					 Points(i).No = TextSelSet.Item(stMinIndex).TextString 'lấy nội dung của Text
				 Else 'là EL
					 'lấy nội dung của Text và chuyển thành số
					 Points(i).EL = Val(TextSelSet.Item(stMinIndex).TextString)
				 End If

				 'Trong trường hợp số lượng điểm quá lớn (>10.000)
				 'cần xoá bớt các dữ liệu đã được xử lý ra khỏi mảng vị trí
				 'nhằm tăng tốc cho bước kế tiếp
			 Catch
			 End Try

			 Try
				 If TextPos(ndMinIndex).Y > Points(i).Pos.Y Then 'STT
					 Points(i).No = TextSelSet.Item(ndMinIndex).TextString
				 Else 'EL
					 Points(i).EL = Val(TextSelSet.Item(ndMinIndex).TextString)
				 End If
			 Catch
			 End Try
		 Next i
	 Catch
	 End Try
 End Sub

 

- Xuất qua Excel

Private Sub cmdExcel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdExcel.Click
	 Try
		 Dim xls As Object
		 Dim Excel As Object = CreateObject("Excel.Application")
		 Excel.Visible = True
		 Try
			 xls = Excel.Worksheets.Add()
		 Catch
			 xls = Excel.Workbooks.Add()
			 xls = Excel.Worksheets.Add()
		 End Try

		 xls.Cells(1, 1) = "STT"
		 xls.Cells(1, 2) = "X"
		 xls.Cells(1, 3) = "Y"
		 xls.Cells(1, 4) = "Z"

		 For i = 0 To PointSelSet.Count - 1
			 xls.Cells(i + 2, 1) = Points(i).No
			 xls.Cells(i + 2, 2) = Points(i).Pos.X
			 xls.Cells(i + 2, 3) = Points(i).Pos.Y
			 xls.Cells(i + 2, 4) = Points(i).EL
		 Next i
	 Catch
	 End Try
 End Sub

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

Em đang tìm hiểu về lệnh in trong cad.em muốn dùng VBA để in tự động 1 file cad được giới hạn bởi khung 400x300.em đã dùng VBA để plot vùng in bằng cách chọn 2 điểm chéo của khung 400x300.Em nhờ các bậc cao thủ trên diễn đàn giúp em sử lý 1 yêu cầu đặt ra như sau: Khi em pick chọn 2 điểm chéo của khung 400x300 thì chương trình sẽ tự động chia vùng đã chọn ra làm 4 vùng nhỏ bằng nhau và đánh số thứ tự 1,2,3,4 vào điểm bất kỳ trên 4 khung đó và cuối cùng là plot 4 vùng đó ra 4 bản(khổ giấy A4).em đang cần mong các cao thủ VBA giúp đỡ.em xin cảm ơ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
Em đang tìm hiểu về lệnh in trong cad.em muốn dùng VBA để in tự động 1 file cad được giới hạn bởi khung 400x300.em đã dùng VBA để plot vùng in bằng cách chọn 2 điểm chéo của khung 400x300.Em nhờ các bậc cao thủ trên diễn đàn giúp em sử lý 1 yêu cầu đặt ra như sau: Khi em pick chọn 2 điểm chéo của khung 400x300 thì chương trình sẽ tự động chia vùng đã chọn ra làm 4 vùng nhỏ bằng nhau và đánh số thứ tự 1,2,3,4 vào điểm bất kỳ trên 4 khung đó và cuối cùng là plot 4 vùng đó ra 4 bản(khổ giấy A4).em đang cần mong các cao thủ VBA giúp đỡ.em xin cảm ơn!

 

Nếu khung có kích thước cố định thì chỉ cần chọn 1 điểm cũng được phải khô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
Nếu khung có kích thước cố định thì chỉ cần chọn 1 điểm cũng được phải không?

Ok nếu chỉ cần chọn 1 điểm cũng được.yêu cầu là phải chia vùng giới hạn trong khung 400x300 đó thành 4 vùng để plot ra A3.em cảm ơn bác 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
Em đang tìm hiểu về lệnh in trong cad.em muốn dùng VBA để in tự động 1 file cad được giới hạn bởi khung 400x300.em đã dùng VBA để plot vùng in bằng cách chọn 2 điểm chéo của khung 400x300.Em nhờ các bậc cao thủ trên diễn đàn giúp em sử lý 1 yêu cầu đặt ra như sau: Khi em pick chọn 2 điểm chéo của khung 400x300 thì chương trình sẽ tự động chia vùng đã chọn ra làm 4 vùng nhỏ bằng nhau và đánh số thứ tự 1,2,3,4 vào điểm bất kỳ trên 4 khung đó và cuối cùng là plot 4 vùng đó ra 4 bản(khổ giấy A4).em đang cần mong các cao thủ VBA giúp đỡ.em xin cảm ơn!

 

Cái này dùng in trực tiếp trong Model

 

Const pWidth as Integer = 400
	  Const pHeight as Integer = 300

	  If acAutoCAD_Link() Then 'Nếu AutoCAD đang chạy và rảnh rỗi
		  'Chuyển qua cửa sổ CAD
		  AppActivate(Acad.Caption)

		  'Bản vẽ hiện hành
		  Dim Dwg As Object = Acad.ActiveDocument

		 'Tạo Text có chiều cao là 10 tại Model
		 Dim TextPos(2) as double
		 Dim TextObj As Object = Dwg.ModelSpace.AddText("hehe", TextPos, 10)

		 'Bật chế độ in trực quan
		Dwg.SetVariable("BACKGROUNDPLOT", 0)

		'Cấu hình in trong Model Space
		NewPlotCfg = Dwg.ModelSpace.Layout
	   NewPlotCfg.ConfigName = "Tên của máy in"

		'Chọn điểm đầu của khung 400x300  
		  Dim SelPoint = Dwg.Utility.GetPoint(, "Chon diem: ")

		  'Điểm đầu
		  Dim stPoint(1) As Double
		  'Điểm đối điện của khung
		  Dim ndPoint(1) As Double

		 'Các giá trị hiển thị cho Text STT
		 'Có 4 phần tử
		 'Lấy thứ tự từ trái qua fải
		 Dim STTs(3) As String = {"vung3","vung4","vung1","vung2"}'viết bằng VB.NET, VB dài hơn

		'Viết bằng VB
		'Dim STTs(3) As String
		'STTs(0)="vung3"
		'STTs(1)="vung4"
		'STTs(2)="vung1"
		'STTs(3)="vung2"

		  Dim col, row As Integer
		  For row = 0 To 1 '2 hàng
			  For col = 0 To 1 '2 cột
				  '2 điểm của vùng cửa sổ
				  stPoint(0) = SelPoint(0) + col * pWidth / 2
				  stPoint(1) = SelPoint(1) + row * pHeight / 2
				  ndPoint(0) = stPoint(0) + pWidth / 2
				  ndPoint(1) = stPoint(1) + pHeight / 2

				 'Vị trí của Text chứa STT
				 TextPos(0) = stPoint(0) + 5
				 TextPos(1) = stPoint(1) + 5
				 TextObj.InsertionPoint = TextPos
				 'STT của Text
				 TextObj.TextString = STTs(col + row * 2)				
				 'Thể hiện nó (cho chắc)
				 TextObj.Update()

				  'Thiết lập cửa sổ in
				  NewPlotCfg.SetWindowToPlot(stPoint, ndPoint)

				  'Thiết lập riêng cấu hình in
				  NewPlotCfg.PlotType = 4 'Kiểu in Window
				  NewPlotCfg.CanonicalMediaName = "A4"
				  NewPlotCfg.PaperUnits = 1 'mm
				  NewPlotCfg.CenterPlot = False
				  NewPlotCfg.PlotOrigin = New Double() {0, 0}

				  'In phần này ra thôi
				  Dwg.Plot.PlotToDevice()
			  Next col
		  Next row

		 'Xóa thằng em
		 TextObj.Delete
	  End if

 

Còn nếu không triển khai được thì dùng cái này cho tiện: (size: 26KB)

acadprint4.jpg

http://www.mediafire.com/file/2nvzy32jlq2/AutoCADPrint.exe

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×