Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
124 replies to this topic

#21 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 29 April 2009 - 01:50 PM

nho cac bac fix giup em


'''''''''''''''''''''''''''''''''''''''''''''''''
' SU LY GIUP TOI PHAN NAY NHE
' Toi muon lan dau tien thi xuat hien dong nay de nguoi dung nhap duong dan
' nhung lan sau thuc hien lenh se khong xuat hien dong nay nua ma duong dan lay tu lan nhap dau tien
'nhap duong dan
pathht = ThisDrawing.Utility.GetString(True, " Nhap duong dan (Enter de ket thuc): ")

''''''''''''''''''''''''''''''''''''''''''''''''''
toi

A Khai báo biến:
Cách 1: chỉ dùng cho hàm này

Static pathht As String

Cách 2: biến pathht dùng chung thì khai báo bên ngoài hàm

Public pathht As String
Sub wblock_bacbk()
...
End Sub

B Trong sub đặt dòng lệnh lấy path vào trong if
 If pathht = "" Then
pathht = ThisDrawing.Utility.GetString(True, " Nhap duong dan (Enter de ket thuc): ")
End If

  • 0

#22 mua_buon12

mua_buon12

    biết vẽ circle

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

Đã gửi 29 April 2009 - 02:37 PM

Cảm ơn bác đã giúp đỡ. Tôi làm như bác nhưng chưa được. ý của tôi là bác sửa đoạn code đó như thế nào cũng được kể cả hiện hộp thoại để người dùng nhập đường dẫn. nếu đánh lệnh lần đầu tiên thì ok nhưng tôi muốn là lần thứ 2 dùng lại lệnh đó không phải nhập đường dẫn nữa. ( nghĩa là các lần tiếp theo không xuất hiện dòng nhập đường dẫn nữa. đường dẫn sẽ lấy bằng đường dẫn trong lần wblock đầu tiên). Các bác có thể sửa trên code tôi up lên rồi send cho tôi được không?
  • 0
Khi Lập Trình Kiến Thức Là Một Phần, Nghệ Thuật Mới Là Tất Cả.

#23 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 05 May 2009 - 02:30 PM

Sub wblock_bacbk()
' Tao doi tuong SelectionSet
Dim ssetObj As AcadSelectionSet
Static pathht As String
Dim filename As String
Dim duongdan As String

On Error Resume Next
Set ssetObj = ThisDrawing.SelectionSets("bacbkselect")
If Err <> 0 Then
Err.Clear
Set ssetObj = ThisDrawing.SelectionSets.Add("bacbkselect")
Else
ssetObj.SelectOnScreen
End If

'''''''''''''''''''''''''''''''''''''''''''''''''
' SU LY GIUP TOI PHAN NAY NHE
' Toi muon lan dau tien thi xuat hien dong nay de nguoi dung nhap duong dan
' nhung lan sau thuc hien lenh se khong xuat hien dong nay nua ma duong dan lay tu lan nhap dau tien
'nhap duong dan
If pathht = "" Then
pathht = ThisDrawing.Utility.GetString(True, " Nhap duong dan (Enter de ket thuc): ")
End If

''''''''''''''''''''''''''''''''''''''''''''''''''
'nhap ten file
filename = ThisDrawing.Utility.GetString(True, " Nhap ten file (Enter de ket thuc): ")

duongdan = pathht & "\" & filename

ThisDrawing.Wblock duongdan, ssetObj

ssetObj.Erase

End Sub


  • 0

#24 mua_buon12

mua_buon12

    biết vẽ circle

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

Đã gửi 06 May 2009 - 08:49 AM

Thank ndtnv!
Đây đúng là cái mà tôi đang cần. Cảm ơn vì sự giúp đỡ
  • 0
Khi Lập Trình Kiến Thức Là Một Phần, Nghệ Thuật Mới Là Tất Cả.

#25 minhtu2004

minhtu2004

    biết lệnh chamfer

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

Đã gửi 06 May 2009 - 09:48 AM

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

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#26 phantuhuong

phantuhuong

    biết dimstyle

  • Moderator
  • PipPipPipPipPip
  • 383 Bài viết
Điểm đánh giá: 200 (khá)

Đã gửi 08 May 2009 - 12:19 PM

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ạ)
  • 0
Bồi dưỡng Excel & VBA cho các đơn vị ở Hà Nội và khu vực lân cận

Từng bước loại đồ Tàu ra khỏi cuộc sống!


#27 minhtu2004

minhtu2004

    biết lệnh chamfer

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

Đã gửi 08 May 2009 - 01:03 PM

cái này minh chạy cadLT phiên bản tiếng Nhật thi ok, nhưng chạy cad LT phiên bản tiếng Anh hoặc cad2006 thì báo lỗi hok hiểu tại sao.
  • 0

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#28 se7en

se7en

    biết vẽ ellipse

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

Đã gửi 30 May 2009 - 08:52 PM

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.c...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...
  • 0
Mê xe và súng
Thích để súng trong xe

#29 q288

q288

    biết lệnh fillet

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

Đã gửi 30 May 2009 - 10:28 PM

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

  • 0

#30 se7en

se7en

    biết vẽ ellipse

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

Đã gửi 01 June 2009 - 10:34 AM

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"...
  • 0
Mê xe và súng
Thích để súng trong xe

#31 q288

q288

    biết lệnh fillet

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

Đã gửi 01 June 2009 - 11:13 AM

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

#32 se7en

se7en

    biết vẽ ellipse

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

Đã gửi 01 June 2009 - 12:25 PM

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...
  • 0
Mê xe và súng
Thích để súng trong xe

#33 q288

q288

    biết lệnh fillet

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

Đã gửi 01 June 2009 - 12:38 PM

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

  • 1

#34 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 01 June 2009 - 04:33 PM

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

#35 q288

q288

    biết lệnh fillet

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

Đã gửi 01 June 2009 - 06:37 PM

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

#36 se7en

se7en

    biết vẽ ellipse

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

Đã gửi 01 June 2009 - 11:10 PM

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...
  • 0
Mê xe và súng
Thích để súng trong xe

#37 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 02 June 2009 - 07:17 AM

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

#38 q288

q288

    biết lệnh fillet

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

Đã gửi 02 June 2009 - 07:45 AM

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

  • 0

#39 anhcos

anhcos

    biết lệnh hatchedit

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

Đã gửi 09 June 2009 - 09:16 PM

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á.
  • -1
Clear sky!

MF Rock collection.

#40 q288

q288

    biết lệnh fillet

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

Đã gửi 09 June 2009 - 10:20 PM

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