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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > .NET > Начертить выноску, с именем блока, в Автокаде VB.NET

Начертить выноску, с именем блока, в Автокаде VB.NET

Ответ
Поиск в этой теме
Непрочитано 08.04.2020, 10:18 #1
Начертить выноску, с именем блока, в Автокаде VB.NET
DEM
 
YngIngKllr
 
СПб
Регистрация: 29.03.2005
Сообщений: 12,968

ПРивет!
Сделал программу по черчению выноски с именем выделенного блока.
Проблема только в тексте который чертится не в той точке которую я указываю.
Код:
[Выделить все]
    <Autodesk.AutoCAD.Runtime.CommandMethod("Run_bloks")>
    Public Sub Run_bloks()
        Dim myPEO As New Autodesk.AutoCAD.EditorInput.PromptEntityOptions(vbLf & "Select BarMark:")
        Dim mydwg, mydb, myed, myPS, myPer, myent, mytrans, mytransman As New Object
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor
        Dim mtxt As New MText()
        Dim db As Database = doc.Database
        mydwg = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        mydb = mydwg.Database
        myed = mydwg.Editor
        myPEO.SetRejectMessage("Выбери блок" & vbCrLf)
        myPEO.AddAllowedClass(GetType(Autodesk.AutoCAD.DatabaseServices.BlockReference), False)
        myPer = myed.GetEntity(myPEO)
        myPS = myPer.Status
        Select Case myPS
            Case Autodesk.AutoCAD.EditorInput.PromptStatus.OK
                'MsgBox("Good job!")
                mytransman = mydwg.TransactionManager
                Using tr As Transaction = mydwg.TransactionManager.StartTransaction
                    myent = myPer.ObjectId.GetObject(Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead)
                    'MsgBox("Entity is on layer " & myent.Layer)
                    'Where did he click?!
                End Using
                MsgBox(myent.Name)
                Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
                    '' Open the Block table for read
                    Dim acBlkTbl As BlockTable
                    acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId,
                                                 OpenMode.ForRead)
                    '' Open the Block table record Model space for write
                    Dim acBlkTblRec As BlockTableRecord
                    acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace),
                                                    OpenMode.ForWrite)
                    '' Create the leader
                    Dim arrowPoint As Point3d = ed.GetPoint(vbLf & "Начальная точка: ").Value
                    Dim symbolPoint As Point3d = ed.GetPoint(vbLf & "Точка расположения текста: ").Value
                    Dim acLdr As MLeader = New MLeader()
                    acLdr.SetDatabaseDefaults()
                    acLdr.AddLeaderLine(arrowPoint)
                    acLdr.AddFirstVertex(0, arrowPoint)
                    acLdr.AddLastVertex(0, symbolPoint)
                    mtxt.SetDatabaseDefaults()
                    mtxt.TextHeight = 0.5
                    mtxt.Contents = myent.Name
                    mtxt.Location = symbolPoint
                    acLdr.MText = mtxt
                    '' Add the new object to Model space and the transaction
                    acBlkTblRec.AppendEntity(acLdr)
                    acTrans.AddNewlyCreatedDBObject(acLdr, True)
                    '' Commit the changes and dispose of the transaction
                    acTrans.Commit()
                End Using
            Case Autodesk.AutoCAD.EditorInput.PromptStatus.Cancel
                MsgBox("You cancelled.")
                Exit Sub
            Case Autodesk.AutoCAD.EditorInput.PromptStatus.Error
                MsgBox("Error warning.")
                Exit Sub
            Case Else
                Exit Sub
        End Select
    End Sub
Ошибка где то в выделенной части красным цветом...
Может кто подкажет как сделать чтобы по нормальному работало.
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
Просмотров: 6580
 
Непрочитано 08.04.2020, 11:04
#2
nickname2019


 
Регистрация: 18.11.2019
Сообщений: 1,492


Для корректировки положения текста нужно юзать
mtxt.setTextLocation();
nickname2019 на форуме  
 
Автор темы   Непрочитано 08.04.2020, 11:15
#3
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


Цитата:
Сообщение от nickname2019 Посмотреть сообщение
mtxt.setTextLocation();
Не является членом Mtext...
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Непрочитано 08.04.2020, 11:41
#4
nickname2019


 
Регистрация: 18.11.2019
Сообщений: 1,492


Цитата:
Сообщение от DEM Посмотреть сообщение
Не является членом Mtext...
acLdr.setTextLocation() ?
nickname2019 на форуме  
 
Непрочитано 08.04.2020, 11:47
#5
Boxa

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


DEM, у меня кровь из глаз пошла от твоего кода... так что я его немного подправил, но не запускал (компилится и ладно)
и да этот код не проставит имена динамических блоков...
Код:
[Выделить все]
    <Autodesk.AutoCAD.Runtime.CommandMethod("Run_bloks")>
    Public Sub Run_bloks()

        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor
        Dim db As Database = doc.Database

        Dim myPEO As New PromptEntityOptions(vbLf & "Select BarMark:")
        myPEO.AllowNone = False
        myPEO.SetRejectMessage("Выбери блок" & vbCrLf)
        myPEO.AddAllowedClass(GetType(BlockReference), False)

        Dim myPer As PromptEntityResult = ed.GetEntity(myPEO)
        If myPer.Status <> PromptStatus.OK Then Return

        Dim blockName As String
        Using blkRef As BlockReference = myPer.ObjectId.Open(OpenMode.ForRead)
            blockName = blkRef.Name
        End Using

        Dim arrowPointOpt As New PromptPointOptions(vbLf & "Начальная точка: ")
        arrowPointOpt.AllowNone = False
        Dim arrowPointRes As PromptPointResult = ed.GetPoint(arrowPointOpt)
        If arrowPointRes.Status <> PromptStatus.OK Then Return

        Dim arrowPoint As Point3d = arrowPointRes.Value

        Dim symbolPointOpt As New PromptPointOptions(vbLf & "Точка расположения текста: ")
        symbolPointOpt.AllowNone = False
        symbolPointOpt.BasePoint = arrowPoint
        symbolPointOpt.UseBasePoint = True
        symbolPointOpt.UseDashedLine = True
        Dim symbolPointRes As PromptPointResult = ed.GetPoint(symbolPointOpt)
        If symbolPointRes.Status <> PromptStatus.OK Then Return

        Dim symbolPoint As Point3d = symbolPointRes.Value

        Using acTrans As Transaction = db.TransactionManager.StartTransaction()

            Dim acBlkTblRec As BlockTableRecord
            acBlkTblRec = acTrans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

            Dim mtxt As New MText()
            mtxt.SetDatabaseDefaults()
            mtxt.TextHeight = 0.5
            mtxt.Contents = blockName

            Dim acLdr As MLeader = New MLeader()
            acLdr.SetDatabaseDefaults()
            acLdr.AddLeaderLine(arrowPoint)
            acLdr.AddFirstVertex(0, arrowPoint)
            acLdr.AddLastVertex(0, symbolPoint)

            acLdr.MText = mtxt
            acLdr.TextLocation = symbolPoint

            If symbolPoint.X < arrowPoint.X Then
                acLdr.SetDogleg(0, New Vector3d(-1, 0, 0))
            Else
                acLdr.SetDogleg(0, New Vector3d(1, 0, 0))
            End If

            acBlkTblRec.AppendEntity(acLdr)
            acTrans.AddNewlyCreatedDBObject(acLdr, True)
            acTrans.Commit()
        End Using
    End Sub
Boxa на форуме  
 
Автор темы   Непрочитано 08.04.2020, 12:20
#6
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


Boxa
Так я по быстрому собрал из кусков кода которые использую
Спасиб...
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > .NET > Начертить выноску, с именем блока, в Автокаде VB.NET

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Установка параметров динамического блока VB.net (Nanocad) gizmo_zx .NET 5 23.04.2015 12:27
Lisp. авто-нумерация атрибута блока. DonJad LISP 10 26.10.2014 02:04
начертить шар в автокаде mutukpuv AutoCAD 40 20.09.2012 17:43
как в автокаде начертить пустотелую 3d трубу feanorro AutoCAD 12 04.09.2012 18:38
Обновление/замена блока с таким же именем из другого файла. Pesec AutoCAD 2 11.11.2009 19:33