Đến nội dung


Hình ảnh
- - - - -

Phóng riêng đối tượng là Text trong bản vẽ


  • Please log in to reply
4 replies to this topic

#1 phantuhuong

phantuhuong

    biết dimstyle

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

Đã gửi 15 December 2009 - 03:33 PM

Một số bản vẽ có nội dung chữ (single line) quá to hoặc quá nhỏ, thủ tục dưới đây sẽ giúp tăng hoặc giảm cỡ chữ trong bản vẽ phù hợp. Từ thủ tục này các bạn có thể tuỳ biến cho phù hợp.
Sub ScaleTextObject()
Dim AcadObj As AcadEntity
Dim SsetObj As AcadSelectionSet
Dim BasePoint As Variant
Dim TextScale As Single

On Error Resume Next

Set SsetObj = ThisDrawing.SelectionSets.Add("TextObj")
SsetObj.SelectOnScreen

TextScale = Val(InputBox("Nhap ty le phong (la so thap phan):"))
For Each AcadObj In SsetObj
If AcadObj.ObjectName = "AcDbText" Then
BasePoint = AcadObj.InsertionPoint
AcadObj.ScaleEntity BasePoint, TextScale
End If

Next
ThisDrawing.SelectionSets.Item("TextObj").Delete
Set SsetObj = Nothing
Set AcadObj = Nothing
End Sub

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


#2 ducboss

ducboss

    biết vẽ line

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

Đã gửi 22 February 2010 - 11:35 AM

vba mình không biết, bạn có thể đóng gói lại thành file để mình dùng thử cái.
  • -1

#3 sson

sson

    biết zoom

  • Members
  • Pip
  • 18 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 21 April 2010 - 01:40 PM

Một số bản vẽ có nội dung chữ (single line) quá to hoặc quá nhỏ, thủ tục dưới đây sẽ giúp tăng hoặc giảm cỡ chữ trong bản vẽ phù hợp. Từ thủ tục này các bạn có thể tuỳ biến cho phù hợp.

Sub ScaleTextObject()
Dim AcadObj As AcadEntity
Dim SsetObj As AcadSelectionSet
Dim BasePoint As Variant
Dim TextScale As Single

On Error Resume Next

Set SsetObj = ThisDrawing.SelectionSets.Add("TextObj")
SsetObj.SelectOnScreen

TextScale = Val(InputBox("Nhap ty le phong (la so thap phan):"))
For Each AcadObj In SsetObj
If AcadObj.ObjectName = "AcDbText" Then
BasePoint = AcadObj.InsertionPoint
AcadObj.ScaleEntity BasePoint, TextScale
End If

Next
ThisDrawing.SelectionSets.Item("TextObj").Delete
Set SsetObj = Nothing
Set AcadObj = Nothing
End Sub


Đoạn mã này rất tiện, nhưng nếu tất cả công việc đều chuyển thành VBA thì mỗi người sẽ có 1 bộ sưu tập mã khủng quá.
Công việc như trên mình hay làm như sau tuy không thể nhanh bằng bằng dùng mã nhưng không cần dùng đến VBA.
- Bạn dùng lệnh pr (PROPERTIES) cửa sổ PROPERTIES sẽ hiện lên ở phía bên trái
- Bôi đen tất cả Text cần chỉnh(chọn lẫn các đối tượng khác cũng không sao)
- Autocad sẽ thống kê được tất cả các loại đã được chọn, sau đó chọn Text, trong cửa sổ PROPERTIES có thể chỉnh được các thuộc tính của text.
- Muốn chỉnh cỡ chữ thì chỉnh thông số của 'Height'
  • 0

#4 phantuhuong

phantuhuong

    biết dimstyle

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

Đã gửi 01 March 2011 - 11:27 PM

Đoạn mã này rất tiện, nhưng nếu tất cả công việc đều chuyển thành VBA thì mỗi người sẽ có 1 bộ sưu tập mã khủng quá.
Công việc như trên mình hay làm như sau tuy không thể nhanh bằng bằng dùng mã nhưng không cần dùng đến VBA.
- Bạn dùng lệnh pr (PROPERTIES) cửa sổ PROPERTIES sẽ hiện lên ở phía bên trái
- Bôi đen tất cả Text cần chỉnh(chọn lẫn các đối tượng khác cũng không sao)
- Autocad sẽ thống kê được tất cả các loại đã được chọn, sau đó chọn Text, trong cửa sổ PROPERTIES có thể chỉnh được các thuộc tính của text.
- Muốn chỉnh cỡ chữ thì chỉnh thông số của 'Height'


Phương pháp này tôi thấy không ổn, vì bản vẽ có thể có nhiều kiểu chữ, kích cỡ chữ khác nhau. Từ thủ tục trên có thể linh hoạt thay đổi cỡ chữ cho từng kiểu.
  • 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!


#5 Detailing

Detailing

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 667 Bài viết
Điểm đánh giá: 278 (khá)

Đã gửi 07 July 2011 - 10:19 AM

Phương pháp này tôi thấy không ổn, vì bản vẽ có thể có nhiều kiểu chữ, kích cỡ chữ khác nhau. Từ thủ tục trên có thể linh hoạt thay đổi cỡ chữ cho từng kiểu.

Kết hợp Quick Select (filter TextStyle) + properties.



  • 0

Ideas don't matter, execution does!

1908412_308002392716743_8165279281236341