Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
6 replies to this topic

#1 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 06 December 2011 - 07:41 AM

Đ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

  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 06 December 2011 - 07:57 AM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 06 December 2011 - 11:44 AM

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

#4 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 06 December 2011 - 12:02 PM

đã 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)
  • 0
Clear sky!

MF Rock collection.

#5 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 07 December 2011 - 02:03 PM


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

#6 phantuhuong

phantuhuong

    biết dimstyle

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

Đã gửi 09 December 2011 - 10:28 PM

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

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


#7 quangvu315

quangvu315

    Chưa sử dụng CAD

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

Đã gửi 18 April 2013 - 09:50 AM

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


  • 0