Автоматический нумеровщик свай для Автокада 2010

Инструкция:
-Выделяем поле или куст свай
-Ставим галки если нужно преобразование из кругов в квадраты
-жмем на бордовую надпись "Нумеровать"
-ждем и ничего не делаем пока на закончится процесс и на белой панели программы не отразится информация по количеству пронумерованных элементов и времени работы.

Ошибка при нумерации круглых свай без преобразования их в квадратные

[Скромно поводя ножкой]
Вот тут мой опус на тему работы со свайным полем.
http://experement.spb.ru/index.php?b=8

PS. более 10000 свай за 10 сек. =)

Круглые не нумерует.
Boxa, Ваша скорость скорее всего зависит от производительности компа, как и моя. Данная прога нумерует 16,67 свай за секунду...

Добавил нумерацию круглых без преобразования, перезалейте архив. Genf, проверяйте.

Не, просто у меня .net библиотека, а у Вас внешняя программа. Разный подход, соответственно и разная скорость. Но это оффтоп, нужно с ним заканчивать =)

Скачал, посмотрел, с 2008 она не работает, поэтому позволю себе несколько пометок про внешний вид.
1. На форме нет указателя, нашла программа акад или нет, а если нашла, то какой?
2. Не понятно с каким типом объектов работает программа (Полилиния, линии, точки, окружности, блоки и др.)
3. Не понял как преобразуется круглые сваи в квадратные. Откуда берутся соотношения размеров сечений.
4. Справка отсутствует, на указанном на форме сайте о программе ничего нет.
5. Кнопка "Нумеровать" совсем не "читаема".
6. Нужно запретить изменение размера окна, в том числе разворачивание на весь экран.
7. Файл программы называется NSV_2010, в заголовке формы N-pils.

Boxa, c половиной пунктов, согласен, на половину есть агрументы, но это как Вы выражаетесь оффтоп, писал быстро расчетку-рисовалку для себя, мне все очевидно, другим не все, здесь полностью с вами согасен, по поводу названий и заголовков,...без комментариев - не конструктивно и к функционалу программы отношения не имеет.
Информация на сайт готовится и не только для этой программы, сейчас не готово.
PS (Ничего личного к Вам не имею, т.к. не имею чести знать лично, и мой продукт не является ни коем образом ни сравнением, ни противопоставлением Вашему, о существовании которого я узнал сегодня.)

Я за то что бы утилит было много похожих и не очень. Меня наоборот радует когда много альтернативы и выбора.
Еще одно не добавил, т.к. не смог посмотреть.
Нет настройки регулирующей положение проставленного номера сваи относительно самой сваи.
По поводу названий, может и придирка, но я сталкивался с тем что ряд пользователей ищут программу по названию и имя файла им ничего не говорит, потому и обратил ваше внимание на это.

Это не профессиональный продукт, мне лично сильно помогает, если поможет еще кому-то и он напишет мне спасибо, буду рад. Все.

можно эффективнее если сваи это некие блоки (все равно какие)

On Error Resume Next


Dim sel As AcadSelectionSet
Dim bl As AcadEntity

'Create the selection set по указанной точке
'Dim gpCode(0) As Integer
'Dim dataValue(0) As Variant
'gpCode(0) = 0
'dataValue(0) = "BLOCK REFERENCE"
'Dim groupCode As Variant, dataCode As Variant
'groupCode = gpCode
'dataCode = dataValue
ThisDrawing.Utility.Prompt "Выберите БЛОКИ для для определения произведения /select DTexts to define product one's/" & vbCrLf

3:
Set sel = ThisDrawing.SelectionSets.Add("DTTSP")
errstr = Err.Description
If errstr <> "" Then
ThisDrawing.Utility.Prompt "Error occured - " + errstr & vbCrLf
ThisDrawing.SelectionSets.Item("DTTSP").Delete
Err.Clear
GoTo 3
End If

sel.SelectOnScreen 'groupCode, dataCode
colvo = sel.Count
If colvo = 0 Then GoTo 2

sn = CDbl(TextBox1.Text)' стартовый номер
Dim tS As AcadText
'Dim ip As Variant
Dim ipp(0 To 2) As Double
Dim bll As AcadBlockReference

For Each bl In sel

'MsgBox bl.ObjectName
If TypeOf bl Is AcadBlockReference Then
'MsgBox "1"
Set bll = bl
' ipp(0) = bll.InsertionPoint(0)
' ipp(1) = bll.InsertionPoint(1)
' ipp(2) = bll.InsertionPoint(2)

ipp(0) = bll.InsertionPoint(0) + (CDbl(TextBox3.Text) * CDbl(ComboBox1.Text))' TextBox3.Text-смещение по Х; ComboBox1.Text - масштаб
ipp(1) = bll.InsertionPoint(1) + (CDbl(TextBox4.Text) * CDbl(ComboBox1.Text)) ' TextBox4.Text-смещение по Y

If ThisDrawing.ActiveSpace = acPaperSpace Then
Set tS = ThisDrawing.PaperSpace.AddText(CStr(sn), ipp, CDbl(ComboBox1.Text) * CDbl(ComboBox2.Text))' ComboBox2.Text -высота текста
Else
Set tS = ThisDrawing.ModelSpace.AddText(CStr(sn), ipp, (CDbl(ComboBox1.Text) * CDbl(ComboBox2.Text)))
End If
sn = sn + 1
TextBox1.Text = CStr(sn)
Else
End If
Next

'Dim blr As AcadBlocks
'For Each blr In sel
'ip = blr.Origin
'ip(0) = ip(0) + CDbl(TextBox3.Text) * CDbl(ComboBox1.Text)
'ip(1) = ip(1) + CDbl(TextBox4.Text) * CDbl(ComboBox1.Text)
'Next



2:
ThisDrawing.SelectionSets.Item("DTTSP").Delete
errstr = Err.Description
If errstr <> "" Then
ThisDrawing.Utility.Prompt "Error occured - " + errstr & vbCrLf
Else
ThisDrawing.Utility.Prompt "Готово/Done/" & vbCrLf
End If
Err.Clear