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

[huunhantvxdts 195]

Đ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

[ketxu 2.984]

Đ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 ạ

[huunhantvxdts 195]

Mình nghĩ nó phải là thuộc tính Rotation chứ không phải là method Rotate bạn ạ

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

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

[anhcos 196]

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

[huunhantvxdts 195]

 

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)

Tôi thử làm như vậy rồi bị lỗi

[phantuhuong 217]

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

[quangvu315 1]

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