Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
huunhantvxdts

[Nhờ chỉnh sữa] vba viết text từ excel

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

Đoạn code sau đây là lấy dữ liệu từ excel rồi ghi vào cad. nhưng tôi muốn các text viết ra có góc 90 độ so với phương ngang nhờ các Bác cao thủ sữa lại dùm. cám ơn các Bác đã quan tâm

Sub diengiatritext(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim giatritext As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
'Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not IsEmpty(Sheets("Vecong").Cells(i, cot1))
   	x(0) = Sheets("vecong").Cells(i, cot1)
   	x(1) = Sheets("Bangbieu").Cells(hang, 6)
   	x(2) = 0
   	noidung = Sheets("vecong").Cells(i + 1, cot2).Value
   	hchu = Sheets("vecong").Cells(2, 8).Value
   	'gocnghieng = Sheets("vecong").Cells(i, cot3).Value
   	Set giatritext = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
   	giatritext.Color = acGreen
   	giatritext.Alignment = acAlignmentMiddleCenter
   	giatritext.TextAlignmentPoint = x
       giatritext.Rotate:' LOI O DONG NAY
       giatritext.Update
   	i = i + 2
Loop
Set giatritext = Nothing
ZoomAll
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

Đoạn code sau đây là lấy dữ liệu từ excel rồi ghi vào cad. nhưng tôi muốn các text viết ra có góc 90 độ so với phương ngang nhờ các Bác cao thủ sữa lại dùm. cám ơn các Bác đã quan tâm

Sub diengiatritext(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim giatritext As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
'Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not IsEmpty(Sheets("Vecong").Cells(i, cot1))
   	x(0) = Sheets("vecong").Cells(i, cot1)
   	x(1) = Sheets("Bangbieu").Cells(hang, 6)
   	x(2) = 0
   	noidung = Sheets("vecong").Cells(i + 1, cot2).Value
   	hchu = Sheets("vecong").Cells(2, 8).Value
   	'gocnghieng = Sheets("vecong").Cells(i, cot3).Value
   	Set giatritext = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
   	giatritext.Color = acGreen
   	giatritext.Alignment = acAlignmentMiddleCenter
   	giatritext.TextAlignmentPoint = x
       giatritext.Rotate:' LOI O DONG NAY
       giatritext.Update
   	i = i + 2
Loop
Set giatritext = Nothing
ZoomAll
End Sub

Mình nghĩ nó phải là thuộc tính Rotation chứ không phải là method Rotate bạ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

đã sưa được rồi, sai cú pháp

giatritext.rotate x, goc '( tính radian)

 

Cái trên là đi vòng (nếu nhiều đối tượng thì sẽ chậm), còn đi tắt đây

giatritext.Rotation = goc (rads)

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ôi thử làm như vậy rồi bị lỗi

 

Đây là ví dụ mẫu trong Help, bạn làm theo là được thôi.

 

Sub Example_Rotation()
' This example creates a text object in model space.
' It then changes the Rotation of the text object.
Dim textObj As AcadText
Dim textString As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double

' Define the text object
textString = "Hello, World."
insertionPoint(0) = 3: insertionPoint(1) = 3: insertionPoint(2) = 0
height = 0.5

' Create the text object in model space
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
ZoomAll
MsgBox "The Rotation is " & textObj.rotation, vbInformation, "Rotation Example"

' Change the value of the Rotation to 45 degrees (.707 radians)
textObj.rotation = 0.707
ZoomAll
MsgBox "The Rotation is set to " & textObj.rotation, vbInformation, "Rotation Example"

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

Bạn thử chạy lại như thến này được không:

Sub diengiatritext(cot1 As Integer, cot2 As Integer, hang As Integer)
    Dim giatritext As AcadText
    Dim x(0 To 2) As Double
    Dim hchu As Double
    'Dim gocnghieng As Double
    Dim noidung As String
    Dim i As Integer
    i = 13
    Do While Not IsEmpty(Sheets("Vecong").Cells(i, cot1))
    x(0) = Sheets("vecong").Cells(i, cot1)
    x(1) = Sheets("Bangbieu").Cells(hang, 6)
    x(2) = 0
    noidung = Sheets("vecong").Cells(i + 1, cot2).Value
    hchu = Sheets("vecong").Cells(2, 8).Value
    'gocnghieng = Sheets("vecong").Cells(i, cot3).Value
    Set giatritext = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
    giatritext.Color = acGreen
    giatritext.Alignment = acAlignmentMiddleCenter
    giatritext.TextAlignmentPoint = x
giatritext.Rotation = 90*180/3.141  'giatritext.Rotate:' LOI O DONG NAY
giatritext.Update
    i = i + 2
    Loop
Set giatritext = Nothing
ZoomAll
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  

×