[Zaraza_1m]

Доброго времени суток.
Очень хочется упростить рутинную работу по ручному переносу данных из visio в AutoCAD и Exel. Хочу решить эту проблему с помощью VBA, поскольку в универе давали азы.
Сейчас рисуется в макросе рамка. Необходимо заполнить ее. Пользуюсь этим:

Sub Text(Ax, Ay, stroka, visota)
Dim startPoint(0 To 2) As Double
startPoint(0) = Ax: startPoint(1) = Ay: startPoint(2) = 0
Set AcadText = ThisDrawing.ModelSpace.AddText(stroka, startPoint, visota)
End Sub

Получается неформатированный текст.
Каким образом можно добиться курсива, изменить угол наклона и прочие стандартные параметры свойств?

И сразу еще один вопрос, так сказать на будущее:
Сечас нарисованный кусок (или блок) я через ctrl+c ctrl+v вставляю на десяток страниц. Можно ли один раз нарисовать его на черновом листе ( маленькая сборка готовых кусков) и с помощью VBA копировать и всавлять в нужные мне координаты?

Пока с Visio через VBA я получаю текстовый файл и обрабатывая его в макросом уже в VBA AutoCADа, прорисовываю. Мягко говоря это нерационально. Что посоветуете.

[Олег (jr.)]

Сообщение от Zaraza_1m Получается неформатированный текст. Каким образом можно добиться курсива, изменить угол наклона и прочие стандартные параметры свойств?

Посмотри свойство ObliqueAngle для простого текста, курсив есть
только для MText
Или можно либо сразу создавать мультилинейный текст вместо простого
либо использовать такой код для преобразования в MText:

Код:

[Выделить все]

Option Explicit

''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''

Sub ConvertToMtext()

        Dim oEnt As AcadEntity
        Dim oText As AcadText
        Dim oMText As AcadMText
        Dim dblWidth As Double
        Dim ftype(0) As Integer
        Dim fdata(0) As Variant
        Dim dxfCode, dxfValue

     Dim oSset As AcadSelectionSet
          With ThisDrawing.SelectionSets
               While .count > 0
                    .Item(0).Delete
               Wend
          Set oSset = .Add("$Texts$")
          End With
          
          ftype(0) = 0: fdata(0) = "TEXT"
          
          dxfCode = ftype: dxfValue = fdata
          
    oSset.SelectOnScreen dxfCode, dxfValue
    
    Dim txtPoint(0 To 2) As Double
    Dim keyWords As String
    keyWords = "TL TC TR ML MC MR BL BC BR"
    
    ThisDrawing.Utility.InitializeUserInput 1, keyWords
    
    Dim selStr As String
    selStr = ThisDrawing.Utility.GetKeyword(vbCrLf & "Choose the mtext justification [TL/TC/TR/ML/MC/MR/BL/BC/BR]: ")
                 Dim outStr As String
                 outStr = ThisDrawing.Utility.GetInput
    Dim alignMark As Integer
    
    Select Case outStr
    
    Case "TL": alignMark = 1
    Case "TC": alignMark = 2
    Case "TR": alignMark = 3
    Case "ML": alignMark = 4
    Case "MC": alignMark = 5
    Case "MR": alignMark = 6
    Case "BL": alignMark = 7
    Case "BC": alignMark = 8
    Case "BR": alignMark = 9
    
    Case Else
    
    End Select
    
    keyWords = "Regular Italic"
    
    ThisDrawing.Utility.InitializeUserInput 1, keyWords

    selStr = ThisDrawing.Utility.GetKeyword( _
    vbCrLf & "Choose the mtext mode [Regular/Italic]: ")
                 outStr = ThisDrawing.Utility.GetInput
                 
                 Dim strPfx As String
                 strPfx = vbNullString
                 
                 If StrComp(outStr, "Italic", vbTextCompare) = 0 Then
                 strPfx = "|i1"
                 End If
    
    keyWords = "Bold Not bold"
    
    ThisDrawing.Utility.InitializeUserInput 1, keyWords

    selStr = ThisDrawing.Utility.GetKeyword(vbCrLf & "Choose the font style [Bold/Not bold]: ")
                 outStr = ThisDrawing.Utility.GetInput
                 
                 Dim strBold As String
                 strBold = vbNullString
                 
                 If StrComp(outStr, "Bold", vbTextCompare) = 0 Then
                 strBold = "|b1"
                 End If
                 
    For Each oEnt In oSset
    
    Set oText = oEnt
    
    Dim txtStr As String
    txtStr = oText.TextString
    Dim strFont As String
    Dim headerStr As String
    strFont = ThisDrawing.TextStyles.Item(oText.StyleName).fontFile
    Dim pos As Integer
    pos = InStr(1, strFont, ".", 0)
    Dim leng As Integer
    leng = Len(strFont)
    headerStr = "{\f" & Left(strFont, leng - (leng - pos) - 1)
    
    If strPfx = vbNullString And strBold = vbNullString Then
    txtStr = headerStr & ";" & txtStr
    
    ElseIf strPfx <> vbNullString And strBold = vbNullString Then
    txtStr = headerStr & strPfx & ";" & txtStr & "}"
       
    ElseIf strBold = vbNullString And strPfx <> vbNullString Then
    txtStr = headerStr & strBold & ";" & txtStr & "}"
    
     ElseIf strPfx <> vbNullString And strBold <> vbNullString Then
    txtStr = headerStr & strPfx & strBold & ";" & txtStr & "}"
    End If
    
    ThisDrawing.Utility.Prompt vbCrLf & txtStr ''debug only
    
    Dim insPt As Variant
    
    insPt = oText.InsertionPoint
    txtPoint(0) = CDbl(insPt(0))
    txtPoint(1) = CDbl(insPt(1))
    txtPoint(2) = CDbl(insPt(2))
    
    Set oMText = ThisDrawing.ModelSpace.AddMText(txtPoint, dblWidth, txtStr)
    oMText.AttachmentPoint = alignMark
    oMText.Update
    
    oText.Delete
    
    Next oEnt
   
End Sub
''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''

~'J'~