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

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

VBA ожидание выбора точки

Ответ
Поиск в этой теме
Непрочитано 07.11.2018, 21:56 #1
VBA ожидание выбора точки
Moker
 
Регистрация: 19.03.2010
Сообщений: 24

Добрый вечер!

Штудировал весь вечер поиск, то ли не так ищу, то ли еще чего... Так и не нашел решение которое бы работало.

У меня есть минипрограмма на VBA в Autocad :

Код:
[Выделить все]
Sub TwoPoints()
     
    Dim strLine(0 To 1) As String
    strLine(0) = "first"
    strLine(1) = "second"
        
    For i = 0 To 1
    ThisDrawing.ActiveLayer = ThisDrawing.Layers(strLine(i))
    ThisDrawing.SendCommand "_point" & vbCr
     
    Next i
    
End Sub
Она должна рисовать две точки в разных слоях (first и second) на экране где я нажму. Координат этих точек нет, я их определяю на глаз.
Однако, я не успею выбрать первую точку, цикл просто меня не ждет. Пробовал вставлять паузу - не помогло, тормозит весь макрос и сделать ничего нельзя.

Проверку на нажатие клавиши мыши сделать не получилось.

Вроде бы есть функции LISP Pause For Input User, но лисп вообще темный лес.

Спасибо.

Последний раз редактировалось Кулик Алексей aka kpblc, 07.11.2018 в 22:43.
Просмотров: 3087
 
Непрочитано 07.11.2018, 22:51
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


А если обойтись без SendCommand?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 07.11.2018, 23:01
1 | #3
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


ThisDrawing.Utility.GetPoint
ну и ThisDrawing.ModelSpace.AddPoint скорее всего
Сергей812 вне форума  
 
Непрочитано 07.11.2018, 23:03
1 | #4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Как вариант:
Код:
[Выделить все]
Option Explicit
Option Base 0

Type tLayer
  Name As String
End Type

Public Sub test()
Dim arLayer(1) As tLayer
  arLayer(0).Name = "First"
  arLayer(1).Name = "Second"
Dim iCount As Integer
Dim cPt As Variant
Dim oPt As AcadPoint
Dim oLayer As AcadLayer

  
  iCount = 0
  While iCount <= UBound(arLayer)
    cPt = ThisDrawing.Utility.GetPoint(, "Check Point : ")
    Set oPt = ThisDrawing.ModelSpace.AddPoint(cPt)
    Set oLayer = ThisDrawing.Layers.Add(arLayer(iCount).Name)
    oPt.Layer = arLayer(iCount).Name
    ' Теоретически здесь можно и цвет задать, и тип линии, и все что угодно
    ' Хоть для точки, хоть для слоя
    iCount = iCount + 1
  Wend
End Sub
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 07.11.2018, 23:21
1 | #5
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Немного добавлю - чтобы корректно выйти в середине процесса без "выброса" в код:
1. Перед циклом
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
While iCount <= UBound(arLayer)
активируете обработчик ошибок
Код:
[Выделить все]
On Error Resume Next
2. После выбора точки:
Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
cPt = ThisDrawing.Utility.GetPoint(, "Check Point : ")
проверяете на наличие ошибок и выходите из процедуры при их наличии:
Код:
[Выделить все]
If Err Then Exit Sub
Сергей812 вне форума  
 
Непрочитано 07.11.2018, 23:36
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Сергей812, не спорю - я не пишу на VBA.
Offtop: P.S. В качестве оффтопа - если не сложно, сбрось(те) в ЛС вариант на C# - просто интересно посмотреть
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 08.11.2018, 09:40
#7
Moker


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Как вариант:
Код:
[Выделить все]
Option Explicit
Option Base 0

Type tLayer
  Name As String
End Type

Public Sub test()
Dim arLayer(1) As tLayer
  arLayer(0).Name = "First"
  arLayer(1).Name = "Second"
Dim iCount As Integer
Dim cPt As Variant
Dim oPt As AcadPoint
Dim oLayer As AcadLayer

  
  iCount = 0
  While iCount <= UBound(arLayer)
    cPt = ThisDrawing.Utility.GetPoint(, "Check Point : ")
    Set oPt = ThisDrawing.ModelSpace.AddPoint(cPt)
    Set oLayer = ThisDrawing.Layers.Add(arLayer(iCount).Name)
    oPt.Layer = arLayer(iCount).Name
    ' Теоретически здесь можно и цвет задать, и тип линии, и все что угодно
    ' Хоть для точки, хоть для слоя
    iCount = iCount + 1
  Wend
End Sub
Всё заработало! Спасибо большое! С GetPoint у меня самого почему-то не получалось.
Только я убрал tLayer и сделал массив как String, и везде убрал .Name , т.к. basic начал ругаться на него.

Спасибо еще раз!
Moker вне форума  
 
Непрочитано 08.11.2018, 09:45
1 | #8
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Думаю для пользы дела, а не в качестве оффтопа:
Код:
[Выделить все]
 using System;
using System.Collections.Generic;
using App = Autodesk.AutoCAD.ApplicationServices;
using Db = Autodesk.AutoCAD.DatabaseServices;
using Ed = Autodesk.AutoCAD.EditorInput;
using Rtm = Autodesk.AutoCAD.Runtime;

[assembly: Rtm.CommandClass(typeof(AddPoint.Commands))]
namespace AddPoint
{
    public class Commands
    {
        [Rtm.CommandMethod("AddPoint")]
        public static void AddPoint()
        {
            List<string> arLayer = new List<string>() { "First", "Second" };
            // Получение текущего документа и базы данных
            App.Document acDoc = App.Application.DocumentManager.MdiActiveDocument;
            if (acDoc == null) return;
            Db.Database acCurDb = acDoc.Database;
            Ed.Editor acEd = acDoc.Editor;

            foreach (string layer in arLayer)
            {
                Ed.PromptPointOptions pntOpt = new Ed.PromptPointOptions("\nPick a point");
                pntOpt.AllowNone = false;
                Ed.PromptPointResult pntRes = acEd.GetPoint(pntOpt);
                if (pntRes.Status != Ed.PromptStatus.OK) return;

                using (Db.Transaction acTrans = acCurDb.TransactionManager.StartOpenCloseTransaction())
                {
                    Db.BlockTableRecord acBlkTblRec = 
             acTrans.GetObject(acCurDb.CurrentSpaceId, Db.OpenMode.ForWrite) as Db.BlockTableRecord;
                    // Создание точки
                    Db.DBPoint acPoint = new Db.DBPoint(pntRes.Value);
                    acPoint.LayerId = crLayers(acCurDb, layer) != Db.ObjectId.Null ? 
                        crLayers(acCurDb, layer) : 
                        acCurDb.Clayer;
                    acPoint.SetDatabaseDefaults();
                    // Добавление нового объекта в запись таблицы блоков и в транзакцию
                    acBlkTblRec.AppendEntity(acPoint);
                    acTrans.AddNewlyCreatedDBObject(acPoint, true);
                    acTrans.Commit();
                }
            }
        }


        private static Db.ObjectId crLayers(Db.Database acCurDb, string layerName)
        {
            Db.ObjectId result = Db.ObjectId.Null;
            // старт транзакции
            using (Db.Transaction acTrans = acCurDb.TransactionManager.StartOpenCloseTransaction())
            {
                // Открытие таблицы слоев для чтения
                using (Db.LayerTable acLyrTbl = 
                    acCurDb.LayerTableId.Open(Db.OpenMode.ForWrite) as Db.LayerTable)
                {
                    if (!acLyrTbl.Has(layerName))
                    {
                        Db.LayerTableRecord acLyrTblRec = new Db.LayerTableRecord();
                        acLyrTblRec.Name = layerName;
                        //acLyrTblRec.Color = Autodesk.AutoCAD.Colors.Color.FromColorIndex(
                        //    Autodesk.AutoCAD.Colors.ColorMethod.ByAci, 1);

                        acLyrTblRec.Description = layerName + " создан программой";
                        acLyrTblRec.LineWeight = Db.LineWeight.LineWeight015;

                        acLyrTblRec.IsPlottable = true;
                        acLyrTblRec.IsOff = false;
                        acLyrTblRec.IsFrozen = false;
                        acLyrTblRec.IsLocked = false;

                        result = acLyrTbl.Add(acLyrTblRec);
                        acTrans.AddNewlyCreatedDBObject(acLyrTblRec, true);
                    }
                    else
                        result = acLyrTbl[layerName];
                }
                acTrans.Commit();
            }
            return result;
        }
    }
}

Последний раз редактировалось Boxa, 17.11.2018 в 09:45.
Boxa вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA ожидание выбора точки

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не работает относительный ввод координат первой точки zaabifff AutoCAD 32 13.01.2017 14:42
Круги в точки Димас AutoCAD 11 26.06.2014 09:37
Как найти предельно допустимое расстояние от наиболее удаленной точки помещения до ближайшего эвакуационного выхода. RuMan Архитектура 1 21.12.2013 21:59
AutoCAD Civil 3D 2011 (Rus) - неактивна функция изменения стиля метки точки в палитре свойств rollstream Вертикальные решения на базе AutoCAD 5 13.11.2013 14:37
Как вычислить расстояние от точки до точки методами ActiveX? Supermax Программирование 31 20.11.2009 12:23