| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Вставка текста из массива VBA в чертеж AutoCad

Вставка текста из массива VBA в чертеж AutoCad

Ответ
Поиск в этой теме
Непрочитано 21.01.2010, 11:04 #1
Вставка текста из массива VBA в чертеж AutoCad
ArtemYa
 
Регистрация: 02.12.2009
Сообщений: 31

Задачка следующая: макрос выбирает координату Х вставки блоков на чертеже, записывает их в массив, сортирует, далее нужно каждую цифру массива вынести отдельным текстом (не MTEXT) на чертеж в столбец с определенным расстоянием между строк, каким образом это можно сделать, подскажите пожалуйста!!!
Просмотров: 4167
 
Непрочитано 21.01.2010, 20:04
#2
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от ArtemYa Посмотреть сообщение
Задачка следующая: макрос выбирает координату Х вставки блоков на чертеже, записывает их в массив, сортирует, далее нужно каждую цифру массива вынести отдельным текстом (не MTEXT) на чертеж в столбец с определенным расстоянием между строк, каким образом это можно сделать, подскажите пожалуйста!!!
Попробуй

Код:
[Выделить все]
Option Explicit

Sub BlockTable()
Dim oEnt As AcadEntity
Dim oBlock As AcadBlockReference
Dim oText As AcadEntity
Dim varpt As Variant
Dim ftype(1) As Integer
Dim fdata(1) As Variant
Dim dxfCode, dxfValue
Dim txtHeight As Double
Dim txtSpace As Double
Dim counter

     Dim oSset As AcadSelectionSet
          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          Set oSset = .Add("Blocks")
          End With

   ftype(0) = 0: ftype(1) = 66
   fdata(0) = "INSERT": fdata(1) = 1
   dxfCode = ftype: dxfValue = fdata
   
oSset.SelectOnScreen dxfCode, dxfValue
MsgBox oSset.Count
ReDim blockdata(0 To oSset.Count - 1, 0 To 1) As Variant

For Each oEnt In oSset
Set oBlock = oEnt
blockdata(counter, 0) = counter
blockdata(counter, 1) = oBlock.InsertionPoint(0)
counter = counter + 1
Next

Dim sortedData As Variant
sortedData = CoolSort(blockdata, 2)
varpt = ThisDrawing.Utility.GetPoint(, vbLf & "Верхняя левая точка")
txtHeight = CDbl(InputBox("Высота текста", "", 200))
txtSpace = CDbl(InputBox("Промежуток между строками", "", 150))

For counter = 0 To UBound(sortedData)
Dim inspt(2) As Double
inspt(0) = CDbl(varpt(0))
inspt(1) = CDbl(varpt(1) - (counter * (txtHeight + txtSpace)))
inspt(2) = CDbl(varpt(2))

Set oText = ThisDrawing.ActiveLayout.Block.AddText( _
Format(CStr(sortedData(counter, 1)), "0.000"), inspt, txtHeight)
Next

End Sub
' see also:
'  http://forum.developing.ru/showthread.php?p=53799#post53799
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' written by Fatty T.O.H. (c)2006 * all rights removed '
' SourceArr - two dimensional array '
' iPos - physical column number (starting from 1) '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Function CoolSort(SourceArr As Variant, iPos As Integer) As Variant

Dim Check As Boolean
ReDim tmpArr(UBound(SourceArr, 2)) As Variant
Dim iCount As Integer
Dim jCount As Integer
Dim nCount As Integer

iPos = iPos - 1
Check = False

Do Until Check
Check = True
For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
If SourceArr(iCount, iPos) > SourceArr(iCount + 1, iPos) Then
For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
tmpArr(jCount) = SourceArr(iCount, jCount)
SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
SourceArr(iCount + 1, jCount) = tmpArr(jCount)
Check = False
Next
End If
Next
Loop

CoolSort = SourceArr

End Function
~'J'~
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 22.01.2010, 16:37
#3
ArtemYa


 
Регистрация: 02.12.2009
Сообщений: 31


спасибо, Олег, разобрался!!
ArtemYa вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Вставка текста из массива VBA в чертеж AutoCad

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
VBA в AutoCAD alle Программирование 47 03.12.2014 11:26
LISP. Выравнивание текста по двум точкам. Krieger Готовые программы 10 24.12.2011 16:02
редактирование многострочного текста в AutoCAD 2006 greta AutoCAD 10 12.03.2007 23:24
AutoCAD LT 2005 и VBA Macros Vidas Программирование 10 03.05.2005 11:00
подскажите кто может где взять литературу по VBA for AutoCad er Программирование 2 28.10.2003 14:08