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.
Đăng nhập để thực hiện theo  
ageke

Cách chuyển font, size, màu cho text

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

ageke    0

xin chào mọi người , mình đang muốn viết 1 macro có tác dụng như sau.

Click chọn 1 đối tượng, macro sẽ tự động chuyển các thuộc tính màu (thành màu trắng), text heigh (thành 2.0000), font (thành Arial).

Đây là đoạn code của mình viết, nhưng chỉ chuyển dc màu, còn lại các đối tượng khác thì ko được, mong mọi người giúp đỡ mình

 

Sub Test()

Dim returnObj As AcadObject

Dim basePnt As Variant

On Error Resume Next

ThisDrawing.Utility.GetEntity returnObj, basePnt, "chon doi tuong"

If Err <> 0 Then

Err.Clear

MsgBox " Error"

Exit Sub

Else

returnObj.color = acWhite

Set returnObj.Font = Arial

returnObj.Update

End If

End Sub

 

Cám ơn mọi người rất 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
ageke    0

Up.

Cả fỏum mấy trăm người hông ai giúp mình hết hả.

^^ Mong mọi người giúp với, cần gấp

Note : hậu tạ chầu cafe.

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
anhcos    177

Để đổi chiều cao của Text:

returnObj.Height = 2

 

Để đổi Font, có 2 cách:

1. tạo một Text style mới, sau đó thay đổi Textstyle của Text/MText

 

dim new_textstyle as string

new_textstyle = "xi tai moi"

 

On Error Resume Next

Thisdrawing.TextStyles.Add(new_textstyle)

 

returnObj.Stylename = new_textstyle

 

2. Đối với MText

Chỉ cần thay đổi nội dung của MText như sau:

Thêm chuỗi \f và typeface của font vào đầu nội dung của Mtext

 

VD:

returnObj.TextString ="\fArial;" & returnObj.TextString 'font Arial.ttf

returnObj.TextString ="\f.Arial;" & returnObj.TextString 'font .Arial.ttf

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

Cám ơn bạn rất nhiều.

Mình đã hiệu chỉnh dc phần height.

Nhưng còn phần font mình ko xử lý dc.

Cụ thể là mình đã làm như vậy.

Sub Test()

Dim returnObj As AcadObject

Dim basePnt As Variant

 

On Error Resume Next

ThisDrawing.Utility.GetEntity returnObj, basePnt, "chon doi tuong"

If Err <> 0 Then

Err.Clear

MsgBox " Error"

Exit Sub

Else

returnObj.color = acWhite

returnObj.Height = 2

returnObj.TextString = "\f Arial;" & returnObj.TextString 'font Arial.ttf

returnObj.TextString = "\f.Arial;" & returnObj.TextString 'font .Arial.ttf

returnObj.Update

End If

End Sub

 

Bạn cho mình info để liên lạc dc ko ạh

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
anhcos    177
returnObj.TextString = "\f Arial;" & returnObj.TextString 'font Arial.ttf

returnObj.TextString = "\f.Arial;" & returnObj.TextString 'font .Arial.ttf

 

Cái này chỉ dùng có 1 dòng lệnh thôi. Bỏ bớt 1 dòng.

 

Bạn dùng cách tạo style mới thì hay hơ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
ageke    0

Thanks bạn nhiều,

Mình đã dùng cách tạo style mới nhưng vẫn không ok.

Code của mình :

Sub Test()

Dim returnObj As AcadObject

Dim basePnt As Variant

Dim new_textstyle As String

new_textstyle = "Arial"

 

On Error Resume Next

ThisDrawing.Utility.GetEntity returnObj, basePnt, "chon doi tuong"

ThisDrawing.TextStyles.Add (new_textstyle)

 

If Err <> 0 Then

Err.Clear

MsgBox " Error"

Exit Sub

Else

returnObj.color = acWhite

returnObj.Height = 2

returnObj.StyleName = new_textstyle

returnObj.Update

End If

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
anhcos    177

Lần trước tôi post thiếu, đã sửa và chạy thử.

 

 Sub Test()
Dim new_textstyle As String
new_textstyle_name = "new text style"

Dim new_style As AcadTextStyle
On Error Resume Next
new_style = ThisDrawing.TextStyles.Add(new_textstyle_name)
If Err <> 0 Then
Set new_style = ThisDrawing.TextStyles.Item(new_textstyle_name) 'nếu đã có thì chọn nó để xài
End If
new_style.SetFont "Arial", False, False, 0, 0

Dim returnObj As AcadObject
Dim basePnt As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity returnObj, basePnt, "chon doi tuong"

If Err <> 0 Then
Err.Clear
MsgBox " Error"
Exit Sub
Else
returnObj.color = acWhite
returnObj.Height = 2
returnObj.StyleName = new_textstyle_name
returnObj.Update
End If
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

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

Đăng nhập để thực hiện theo  

×