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

Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Нумерация листов из "менеджера подшивок"

Нумерация листов из "менеджера подшивок"

Ответ
Поиск в этой теме
Непрочитано 05.01.2006, 15:10
Нумерация листов из "менеджера подшивок"
Peter
 
строительство
 
Украина
Регистрация: 27.02.2005
Сообщений: 319

Акад2006ру. Создал подшивку. Получил список листов и автоматическую нумерацию в подшивке. Исключил один лист, и нужно перенумеровать оставшиеся листы (в подшивке). Возможно ли это средствами Акада? Может кто поможет с лиспом для перенумерации листов в "подшивке". Или подскажите другой способ автоматической нумерации листов ,скомпанованных в пространстве листа, чтоб можно было автоматически перенумеровывать набор листов собранных с разных файлов.
Спасибо.
__________________
С ув. Петр
Просмотров: 37487
 
Непрочитано 18.05.2016, 10:50
#101
Jmix


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


Понял. Моя ошибка. Я принял по умолчанию следующее местонахождение макроса и вспомогательных файлов макроса: c:\program files\autodesk\autocad 2016\00_GAM. (Application.Path + "\00_GAM")

В исправленном варианте макрос сам находит свою папку и вспомогательные файлы в ней.
Вложения
Тип файла: rar 00_GAM.rar (174.9 Кб, 58 просмотров)
Jmix вне форума  
 
Автор темы   Непрочитано 18.05.2016, 11:15
#102
Peter

строительство
 
Регистрация: 27.02.2005
Украина
Сообщений: 319


Опять не работает
Цитата:
Сообщение от Jmix Посмотреть сообщение
Понял. Моя ошибка. Я принял по умолчанию следующее местонахождение макроса и вспомогательных файлов макроса: c:\program files\autodesk\autocad 2016\00_GAM. (Application.Path + "\00_GAM")

В исправленном варианте макрос сам находит свою папку и вспомогательные файлы в ней.
Вложения
00_GAM.rar (174.9 Кб, 0 просмотров)
Миниатюры
Нажмите на изображение для увеличения
Название: 444.jpg
Просмотров: 75
Размер:	116.9 Кб
ID:	170560  Нажмите на изображение для увеличения
Название: 333.jpg
Просмотров: 68
Размер:	120.1 Кб
ID:	170561  
__________________
С ув. Петр
Peter вне форума  
 
Непрочитано 18.05.2016, 11:28
#103
Jmix


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


Возможно ошибка возникает из-за отключенного компонента в VBA.
Зайдите в меню Tools - References... Уберите галочку AcSmComponents17.... и поставьте галочку галочку AcSmComponents20...
Jmix вне форума  
 
Автор темы   Непрочитано 18.05.2016, 11:55
#104
Peter

строительство
 
Регистрация: 27.02.2005
Украина
Сообщений: 319


Цитата:
Сообщение от Jmix Посмотреть сообщение
Возможно ошибка возникает из-за отключенного компонента в VBA.
Зайдите в меню Tools - References... Уберите галочку AcSmComponents17.... и поставьте галочку галочку AcSmComponents20...
Простите, у меня русская версия , можно ли чуть более подробнее ... спасибо за помощь
__________________
С ув. Петр
Peter вне форума  
 
Непрочитано 18.05.2016, 12:06
#105
Jmix


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


Цитата:
Сообщение от Jmix Посмотреть сообщение
Возможно ошибка возникает из-за отключенного компонента в VBA.
Зайдите в меню Tools - References... Уберите галочку AcSmComponents17.... и поставьте галочку галочку AcSmComponents20...
Меню не для Autocad, а для Microsoft Visual Basic for Application
В Автокаде зайдите в меню Сервис - Макрос - Редактор Visual Basic.
Выделите в окне Project - Pdeign. Далее зайдите в меню Tools - References... Уберите галочку AcSmComponents17.... и поставьте галочку галочку AcSmComponents20...
Jmix вне форума  
 
Автор темы   Непрочитано 18.05.2016, 12:55
#106
Peter

строительство
 
Регистрация: 27.02.2005
Украина
Сообщений: 319



----- добавлено через ~6 мин. -----
https://www.youtube.com/watch?v=6S6BbxhAF8c
__________________
С ув. Петр
Peter вне форума  
 
Непрочитано 22.06.2016, 09:27
#107
KEHT


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


Цитата:
Сообщение от Jmix Посмотреть сообщение
Выделите в окне Project - Pdeign. Далее зайдите в меню Tools - References... Уберите галочку AcSmComponents17.... и поставьте галочку галочку AcSmComponents20...
Т.е. программа будет работать только с 2015 автокада? 2011 Автокад не работает? нету AcSmComponents20.???
KEHT вне форума  
 
Непрочитано 22.06.2016, 10:35
#108
KEHT


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


нашел AcSmComponents20 скопировал, запустилась программка, но ошибка при автонумерации.
Миниатюры
Нажмите на изображение для увеличения
Название: Microsoft Visual Basic - D!USERPRG_LSPПодшивка00_GAMPdesign.dvb [break].jpg
Просмотров: 81
Размер:	30.0 Кб
ID:	172426  Нажмите на изображение для увеличения
Название: Microsoft Visual Basic.jpg
Просмотров: 63
Размер:	15.1 Кб
ID:	172427  
KEHT вне форума  
 
Непрочитано 31.05.2018, 09:46
#109
KEHT


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


Jmix, ты забросил развитие своей программы? Кто нибудь вообще пытается развивать нумерацию подшивок? Тут все так начиналось, и заглохло
KEHT вне форума  
 
Непрочитано 31.05.2018, 09:55
#110
trir


 
Регистрация: 18.12.2010
Сообщений: 3,444


я для себя всё сделал

----- добавлено через ~26 мин. -----
Код:
[Выделить все]
Imports acEdInp = Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Imports acWin = Autodesk.AutoCAD.Windows
Imports acApp = Autodesk.AutoCAD.ApplicationServices
'
Imports ACSMCOMPONENTS21Lib
'
Imports System
Imports System.IO
Imports System.Text
Imports System.Windows.Forms

Public Class Commands
    'Shared ps As acWin.PaletteSet = Nothing
    'Shared uc As UserControl1 = Nothing
    Public Const ClassId As String = ""
    Public Const InterfaceId As String = ""
    Public Const EventsId As String = ""

    Shared sheetSetManager As IAcSmSheetSetMgr = Nothing

    <CommandMethod("SSHelp")> _
    Public Sub SSHelp()
        Dim editor As acEdInp.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        editor.WriteMessage("GetProjValues - посмотреть свойства проекта подшивки" & vbLf)
        editor.WriteMessage("SetProjValue - установить свойство проекта подшивки" & vbLf)
        editor.WriteMessage("GetCustomProperty - посмотреть дополнительные свойства подшивки" & vbLf)
        editor.WriteMessage("SetCustomProperty - установить дополнительные свойства подшивки" & vbLf)
        editor.WriteMessage("RenameSubSet - переименовать разделы подшивки" & vbLf)
        editor.WriteMessage("SortSheet - сортирует листы в группах" & vbLf)
    End Sub

    Public Sub ProcessEnumerator(editor As acEdInp.Editor, wSSCol As IAcSmEnumComponent)
        Dim CPV As IAcSmComponent = wSSCol.Next
        Do While Not (CPV Is Nothing)
            Dim tname As String = CPV.GetTypeName
            editor.WriteMessage(vbLf & "SS Name : " & CPV.GetName & " type: " & tname)
            If tname = "AcSmSubset" Then
                Dim wSubSet As AcSmSubset = CPV
                Dim subName As String = wSubSet.GetName
                If Not String.IsNullOrEmpty(subName) Then ProcessEnumerator(editor, wSubSet.GetSheetEnumerator)
            End If
            CPV = wSSCol.Next
        Loop
    End Sub

    ''' <summary>
    ''' Получение пути к подшивке и её открытие
    ''' </summary>
    ''' <param name="editor"> Editor для взаимодействия с пользователем </param>
    ''' <returns> БД подшивки </returns>
    ''' <remarks></remarks>
    Public Function GetSSDB(editor As acEdInp.Editor) As AcSmDatabase
        Dim pStrOpts As acEdInp.PromptStringOptions = New acEdInp.PromptStringOptions(vbLf & "Путь к подшивке: ")
        pStrOpts.AllowSpaces = True
        Dim PrRes As acEdInp.PromptResult = editor.GetString(pStrOpts)
        If PrRes.Status = acEdInp.PromptStatus.OK Then
            Dim Path As String = PrRes.StringResult
            Try
                If sheetSetManager Is Nothing Then sheetSetManager = New AcSmSheetSetMgr
                Return sheetSetManager.OpenDatabase(Path, False)
            Catch ex As System.IO.FileNotFoundException
                editor.WriteMessage("Файл не найден!")
                Return Nothing
            End Try
        Else
            Return Nothing
        End If
    End Function

    ''' <summary>
    ''' Получение пути к подшивке, через окно диалога выбора файла, и её открытие
    ''' </summary>
    ''' <param name="editor"> Editor для взаимодействия с пользователем </param>
    ''' <returns> БД подшивки </returns>
    ''' <remarks></remarks>
    Public Function GetSSDB2(editor As acEdInp.Editor) As AcSmDatabase
        Dim sTypes As String = "dst"
        Dim flags As Autodesk.AutoCAD.Windows.OpenFileDialog.OpenFileDialogFlags
        Dim wDial As New acWin.OpenFileDialog("Открыть подшивку", "", sTypes, "Открыть подшивку", flags)
        If wDial.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
            Try
                If sheetSetManager Is Nothing Then sheetSetManager = New AcSmSheetSetMgr
                Return sheetSetManager.OpenDatabase(wDial.Filename(), False)
            Catch ex As System.Exception
                editor.WriteMessage("error: " & ex.ToString)
                Return Nothing
            End Try
        Else
            Return Nothing
        End If
    End Function

    ''' <summary>
    ''' Печать списка CustomProperty подшивки
    ''' </summary>
    ''' <remarks></remarks>
    <CommandMethod("GetCustomProperty")> _
    Public Sub GetCustomProperty()
        Dim editor As acEdInp.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase
        Dim wStr As String = ""
        Dim CPV As New AcSmCustomPropertyValue
        sheetSetDatabase = GetSSDB(editor)
        If sheetSetDatabase IsNot Nothing Then
            Dim PrCol As IAcSmEnumProperty
            PrCol = sheetSetDatabase.GetSheetSet.GetCustomPropertyBag.GetPropertyEnumerator()
            Do While Not (CPV Is Nothing)
                PrCol.Next(wStr, CPV)
                If Not (CPV Is Nothing) Then
                    editor.WriteMessage(wStr & " : " & CPV.GetValue.ToString & vbLf)
                End If
            Loop
            sheetSetManager.Close(sheetSetDatabase)
        End If
    End Sub

    ''' <summary>
    ''' Установка нового значения для свойства (CustomProperty)
    ''' </summary>
    ''' <param name="sheetSetDatabase"> БД подшивки </param>
    ''' <param name="PropertyName"> Имя свойства </param>
    ''' <param name="nValue"> Новое значение </param>
    ''' <remarks></remarks>
    Public Sub SetCP(sheetSetDatabase As AcSmDatabase, PropertyName As String, nValue As String)
        Dim SmEnumProperty As AcSmCustomPropertyBag
        Dim CPV As New AcSmCustomPropertyValue
        SmEnumProperty = sheetSetDatabase.GetSheetSet.GetCustomPropertyBag
        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
            sheetSetDatabase.LockDb(sheetSetDatabase) 'start
            CPV = SmEnumProperty.GetProperty(PropertyName)
            If (CPV IsNot Nothing) Then
                CPV.SetValue(nValue)
                SmEnumProperty.SetProperty(PropertyName, CPV)
            Else
                sheetSetDatabase.UnlockDb(sheetSetDatabase) 'end
                Throw New System.Exception("Свойство не найденно")
            End If
            sheetSetDatabase.UnlockDb(sheetSetDatabase) 'end
        End If
    End Sub

    ''' <summary>
    ''' Установка нового значения для свойства (CustomProperty)
    ''' </summary>
    ''' <remarks></remarks>
    <CommandMethod("SetCustomProperty")> _
    Public Sub SetCustomProperty()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB(editor)
        If sheetSetDatabase IsNot Nothing Then
            Dim pStrOpts As acEdInp.PromptStringOptions = New acEdInp.PromptStringOptions(vbLf & "Имя свойства: ")
            pStrOpts.AllowSpaces = True
            Dim PrRes As acEdInp.PromptResult = editor.GetString(pStrOpts)
            If PrRes.Status = acEdInp.PromptStatus.OK Then
                Dim PropertyName As String = PrRes.StringResult.Trim
                pStrOpts.Message = "Новое значение: "
                PrRes = editor.GetString(pStrOpts)
                If PrRes.Status = acEdInp.PromptStatus.OK Then
                    Dim nValue As String = PrRes.StringResult
                    Try
                        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                            SetCP(sheetSetDatabase, PropertyName, nValue)
                        Else
                            editor.WriteMessage(sheetSetDatabase.GetFileName & " is Lock")
                        End If
                    Catch ex As System.Exception
                        'sheetSetDatabase.UnlockDb(sheetSetDatabase)
                        editor.WriteMessage(Environment.NewLine & "error: " & ex.ToString)
                    End Try
                End If
            End If
        End If
    End Sub

    ''' <summary>
    ''' Получение свойств проекта 
    ''' </summary>
    ''' <remarks></remarks>
    <CommandMethod("GetProjValues")> _
    Public Sub GetProjValues()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB(editor)
        If sheetSetDatabase IsNot Nothing Then
            Try
                Dim ss2 As IAcSmSheetSet2
                ss2 = sheetSetDatabase.GetSheetSet
                editor.WriteMessage("Номер проекта: " & ss2.GetProjectNumber & vbLf)
                editor.WriteMessage("Имя проекта: " & ss2.GetProjectName & vbLf)
                editor.WriteMessage("Фаза проекта: " & ss2.GetProjectPhase & vbLf)
                editor.WriteMessage("Этап проекта: " & ss2.GetProjectMilestone & vbLf)
                sheetSetManager.Close(sheetSetDatabase)
            Catch ex As System.Exception
                editor.WriteMessage("error: " & ex.ToString)
            End Try
        End If
    End Sub

    ''' <summary>
    ''' Установка нового значения для свойства проекта
    ''' </summary>
    ''' <param name="sheetSetDatabase"> БД подшивки </param>
    ''' <param name="PropertyName"> имя свойства </param>
    ''' <param name="nValue"> новое значение </param>
    ''' <remarks></remarks>
    Public Sub SetProjP(sheetSetDatabase As AcSmDatabase, PropertyName As String, nValue As String)
        Dim ss2 As IAcSmSheetSet2
        ss2 = sheetSetDatabase.GetSheetSet
        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
            sheetSetDatabase.LockDb(sheetSetDatabase)
            Select Case PropertyName.ToLower
                Case "d", "dname"
                    Dim ss1 As IAcSmSheetSet
                    ss1 = sheetSetDatabase.GetSheetSet
                    ss1.SetName(nValue)
                Case "n", "number"
                    ss2.SetProjectNumber(nValue)
                Case "a", "name"
                    ss2.SetProjectName(nValue)
                Case "p", "phase"
                    ss2.SetProjectPhase(nValue)
                Case "m", "milestone"
                    ss2.SetProjectMilestone(nValue)
            End Select
            sheetSetDatabase.UnlockDb(sheetSetDatabase)
        End If
    End Sub

    ''' <summary>
    ''' Установка нового значения для свойства проекта
    ''' </summary>
    ''' <remarks></remarks>
    <CommandMethod("SetProjValue", CommandFlags.Interruptible)> _
    Public Sub SetProjValue()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        'Path As String, PropertyName As String, nValue As String
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB(editor)
        If sheetSetDatabase IsNot Nothing Then
            Dim pStrOpts As acEdInp.PromptStringOptions = New acEdInp.PromptStringOptions(vbLf & "Имя свойства (Dname/Number/nAme/Phase/Milestone): ")
            pStrOpts.AllowSpaces = True
            Dim PrRes As acEdInp.PromptResult = editor.GetString(pStrOpts)
            If PrRes.Status = acEdInp.PromptStatus.OK Then
                Dim PropertyName As String = PrRes.StringResult.Trim
                pStrOpts.Message = "Новое значение: "
                PrRes = editor.GetString(pStrOpts)
                If PrRes.Status = acEdInp.PromptStatus.OK Then
                    Dim nValue As String = PrRes.StringResult
                    Try
                        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                            SetProjP(sheetSetDatabase, PropertyName, nValue)
                        Else
                            editor.WriteMessage(sheetSetDatabase.GetFileName & " is Lock")
                        End If
                        sheetSetManager.Close(sheetSetDatabase)
                    Catch ex As System.Exception
                        sheetSetDatabase.UnlockDb(sheetSetDatabase)
                        editor.WriteMessage("error: " & ex.ToString)
                    End Try
                End If
            End If
        End If
    End Sub

    ''' <summary>
    ''' Переименовать все разделы
    ''' </summary>
    ''' <param name="tagName"> Имя раздела </param>
    ''' <param name="nName"> Новое имя раздела </param>
    ''' <param name="wSSCol"> Подразделы </param>
    ''' <param name="sheetSetDatabase"> БД подшивки </param>
    ''' <remarks></remarks>
    Public Sub fRenameSubSet(tagName As String, nName As String, wSSCol As IAcSmEnumComponent, sheetSetDatabase As AcSmDatabase)
        Dim CPV As IAcSmComponent = wSSCol.Next
        Do While Not (CPV Is Nothing)
            Dim tname As String = CPV.GetTypeName
            If tname = "AcSmSubset" Then
                If CPV.GetName() = tagName Then
                    If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                        sheetSetDatabase.LockDb(sheetSetDatabase)
                        CPV.SetName(nName)
                        sheetSetDatabase.UnlockDb(sheetSetDatabase)
                    End If
                End If
                Dim wSubSet As AcSmSubset = CPV
                Dim subName As String = wSubSet.GetName
                If Not String.IsNullOrEmpty(subName) Then fRenameSubSet(tagName, nName, wSubSet.GetSheetEnumerator, sheetSetDatabase)
            End If
            CPV = wSSCol.Next
        Loop
    End Sub

    ''' <summary>
    ''' Получение списка имён свойств (CustomProperty)
    ''' </summary>
    ''' <param name="SmEnumProperty"> Набор свойств (CustomProperty) </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetCPNameList(SmEnumProperty As AcSmCustomPropertyBag) As List(Of String)
        Dim rList As New List(Of String)
        Dim wStr As String = ""
        Dim CPV As New AcSmCustomPropertyValue
        Dim PrCol As IAcSmEnumProperty
        PrCol = SmEnumProperty.GetPropertyEnumerator()
        Do While Not (CPV Is Nothing)
            PrCol.Next(wStr, CPV)
            If Not (CPV Is Nothing) Then
                rList.Add(wStr)
            End If
        Loop
        Return rList
    End Function

    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="Sheet"></param>
    ''' <param name="PropertyName"></param>
    ''' <param name="nValue"></param>
    ''' <remarks></remarks>
    Public Sub SheetSetCP(Sheet As AcSmSheet, PropertyName As String, nValue As String)
        Dim sheetSetDatabase As AcSmDatabase = Sheet.GetDatabase()
        Dim SmEnumProperty As AcSmCustomPropertyBag
        Dim CPV As New AcSmCustomPropertyValue
        SmEnumProperty = Sheet.GetCustomPropertyBag
        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
            sheetSetDatabase.LockDb(sheetSetDatabase) 'start
            CPV = SmEnumProperty.GetProperty(PropertyName)
            If (CPV IsNot Nothing) Then
                CPV.SetValue(nValue)
                SmEnumProperty.SetProperty(PropertyName, CPV)
            End If
            sheetSetDatabase.UnlockDb(sheetSetDatabase) 'end
        End If
    End Sub


    Public Sub SheetSetCP2(Sheet As AcSmSheet, PropertyName As String, nValue As String)
        Dim sheetSetDatabase As AcSmDatabase = Sheet.GetDatabase()
        Dim SmEnumProperty As AcSmCustomPropertyBag
        Dim CPV As New AcSmCustomPropertyValue
        SmEnumProperty = Sheet.GetCustomPropertyBag
        CPV = SmEnumProperty.GetProperty(PropertyName)
        If (CPV IsNot Nothing) Then
            CPV.SetValue(nValue)
            SmEnumProperty.SetProperty(PropertyName, CPV)
        End If
    End Sub

    Public Sub fSubSetSetCP(wSSCol As IAcSmEnumComponent, PropertyName As String, nValue As String)
        Dim CPV As IAcSmComponent = wSSCol.Next
        'Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Do While Not (CPV Is Nothing)
            Dim tname As String = CPV.GetTypeName
            'editor.WriteMessage(vbLf & "tname: " & tname)
            If tname = "AcSmSheet" Then
                SheetSetCP2(CPV, PropertyName, nValue)
            End If
            If tname = "AcSmSubset" Then
                Dim wSubSet As AcSmSubset = CPV
                Dim subName As String = wSubSet.GetName
                If Not String.IsNullOrEmpty(subName) Then fSubSetSetCP(wSubSet.GetSheetEnumerator, PropertyName, nValue)
            End If
            CPV = wSSCol.Next
        Loop
    End Sub

    '<CommandMethod("test1")> _
    Public Sub test1()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB(editor)
        If sheetSetDatabase IsNot Nothing Then
            Dim pStrOpts As acEdInp.PromptStringOptions = New acEdInp.PromptStringOptions(vbLf & "Имя свойства: ")
            pStrOpts.AllowSpaces = True
            Dim PrRes As acEdInp.PromptResult = editor.GetString(pStrOpts)
            If PrRes.Status = acEdInp.PromptStatus.OK Then
                Dim PropertyName As String = PrRes.StringResult
                'editor.WriteMessage(Environment.NewLine)
                pStrOpts.Message = "Новое значение: "
                PrRes = editor.GetString(pStrOpts)
                If PrRes.Status = acEdInp.PromptStatus.OK Then
                    Dim nValue As String = PrRes.StringResult
                    Try
                        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                            fSubSetSetCP(sheetSetDatabase.GetSheetSet().GetSheetEnumerator, PropertyName, nValue)
                        Else
                            editor.WriteMessage(sheetSetDatabase.GetFileName & " is Lock")
                        End If
                    Catch ex As System.Exception
                        editor.WriteMessage("error: " & ex.ToString)
                    End Try
                End If
            End If
            ' fSubSetSetCP(sheetSetDatabase, sheetSetDatabase.GetSheetSet().GetSheetEnumerator, "", "")
        End If
    End Sub

    <CommandMethod("SetAllSheetCustomProperty")> _
    Public Sub SetAllSheetCustomProperty()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB(editor)
        If sheetSetDatabase IsNot Nothing Then
            Dim pStrOpts As acEdInp.PromptStringOptions = New acEdInp.PromptStringOptions(vbLf & "Имя свойства: ")
            pStrOpts.AllowSpaces = True
            Dim PrRes As acEdInp.PromptResult = editor.GetString(pStrOpts)
            If PrRes.Status = acEdInp.PromptStatus.OK Then
                Dim PropertyName As String = PrRes.StringResult
                'editor.WriteMessage(Environment.NewLine)
                pStrOpts.Message = "Новое значение: "
                PrRes = editor.GetString(pStrOpts)
                If PrRes.Status = acEdInp.PromptStatus.OK Then
                    Dim nValue As String = PrRes.StringResult
                    Try
                        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                            sheetSetDatabase.LockDb(sheetSetDatabase)
                            fSubSetSetCP(sheetSetDatabase.GetSheetSet().GetSheetEnumerator, PropertyName, nValue)
                            sheetSetDatabase.UnlockDb(sheetSetDatabase)
                        Else
                            editor.WriteMessage(sheetSetDatabase.GetFileName & " is Lock")
                        End If
                    Catch ex As System.Exception
                        editor.WriteMessage("error: " & ex.ToString)
                    End Try
                End If
            End If
            ' fSubSetSetCP(sheetSetDatabase, sheetSetDatabase.GetSheetSet().GetSheetEnumerator, "", "")
        End If
    End Sub

    <CommandMethod("SetAllSheetCustomProperty2")> _
    Public Sub SetAllSheetCustomProperty2()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB2(editor)
        If sheetSetDatabase IsNot Nothing Then
            Dim pKeyOpts As acEdInp.PromptKeywordOptions = New acEdInp.PromptKeywordOptions(vbLf & "Имя свойства: ")
            pKeyOpts.AppendKeywordsToMessage = True
            pKeyOpts.AllowArbitraryInput = True
            Dim kList As List(Of String) = GetCPNameList(sheetSetDatabase.GetSheetSet.GetCustomPropertyBag)
            kList.ForEach(Sub(obj) pKeyOpts.Keywords.Add("'" & obj & "'"))
            Dim PrRes As acEdInp.PromptResult = editor.GetKeywords(pKeyOpts)
            If PrRes.Status = acEdInp.PromptStatus.OK Then
                Dim PropertyName As String = PrRes.StringResult
                If PropertyName <> "" Then
                    Dim pStrOpts As acEdInp.PromptStringOptions = New acEdInp.PromptStringOptions(vbLf & "Новое значение: ")
                    PrRes = editor.GetString(pStrOpts)
                    If PrRes.Status = acEdInp.PromptStatus.OK Then
                        Dim nValue As String = PrRes.StringResult
                        Try
                            If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                                sheetSetDatabase.LockDb(sheetSetDatabase)
                                fSubSetSetCP(sheetSetDatabase.GetSheetSet().GetSheetEnumerator, PropertyName, nValue)
                                sheetSetDatabase.UnlockDb(sheetSetDatabase)
                            Else
                                editor.WriteMessage(sheetSetDatabase.GetFileName & " is Lock")
                            End If
                        Catch ex As System.Exception
                            editor.WriteMessage("error: " & ex.ToString)
                        End Try
                    End If
                End If
            End If
            ' fSubSetSetCP(sheetSetDatabase, sheetSetDatabase.GetSheetSet().GetSheetEnumerator, "", "")
        End If
    End Sub

    <CommandMethod("test2")> _
    Public Sub test2()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB2(editor)
        If sheetSetDatabase IsNot Nothing Then
            Dim pKeyOpts As acEdInp.PromptKeywordOptions = New acEdInp.PromptKeywordOptions(vbLf & "Имя свойства: ")
            pKeyOpts.AppendKeywordsToMessage = True
            'pKeyOpts.AllowArbitraryInput = True
            Dim kList As List(Of String) = GetCPNameList(sheetSetDatabase.GetSheetSet.GetCustomPropertyBag)
            kList.ForEach(Sub(obj) pKeyOpts.Keywords.Add("""""" & obj & "1""""", """""" & obj & "2""""", """""" & obj & "3"""""))
            Dim PrRes As acEdInp.PromptResult = editor.GetKeywords(pKeyOpts)
            If PrRes.Status = acEdInp.PromptStatus.OK Then
                Dim PropertyName As String = PrRes.StringResult
                If PropertyName <> "" Then
                    editor.WriteMessage("Value: " & PropertyName)
                End If
            End If
            ' fSubSetSetCP(sheetSetDatabase, sheetSetDatabase.GetSheetSet().GetSheetEnumerator, "", "")
        End If
    End Sub

    ''' <summary>
    ''' Переименовать разделы
    ''' </summary>
    ''' <remarks></remarks>
    <CommandMethod("RenameSubSet")> _
    Public Sub RenameSubSet()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB(editor)
        If sheetSetDatabase IsNot Nothing Then
            Dim pStrOpts As acEdInp.PromptStringOptions = New acEdInp.PromptStringOptions(vbLf & "Старое название: ")
            pStrOpts.AllowSpaces = True
            Dim PrRes As acEdInp.PromptResult = editor.GetString(pStrOpts)
            If PrRes.Status = acEdInp.PromptStatus.OK Then
                Dim tagName As String = PrRes.StringResult
                pStrOpts.Message = "Новое название: "
                PrRes = editor.GetString(pStrOpts)
                If PrRes.Status = acEdInp.PromptStatus.OK Then
                    Dim nName As String = PrRes.StringResult
                    Try
                        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                            fRenameSubSet(tagName, nName, sheetSetDatabase.GetSheetSet().GetSheetEnumerator, sheetSetDatabase)
                        Else
                            editor.WriteMessage(tagName & " is Lock")
                        End If
                        sheetSetManager.Close(sheetSetDatabase)
                    Catch ex As System.Exception
                        editor.WriteMessage("error: " & ex.ToString)
                    End Try
                End If
            End If
        End If
    End Sub


    '<CommandMethod("ARCHIVE_DST")> _
    'Public Sub ARCHIVE_DST()
    '    Dim acDoc As Document = acApp.Application.DocumentManager.MdiActiveDocument
    '    Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acDoc.Editor()
    '    Try
    '        If sheetSetManager Is Nothing Then sheetSetManager = New AcSmSheetSetMgr
    '        'Return sheetSetManager.OpenDatabase(Path, False)
    '    Catch ex As System.Exception
    '        editor.WriteMessage("error: " & ex.ToString)
    '        'Return Nothing
    '    End Try
    '    sheetSetManager.CloseAll()
    '    Dim sheetSetDatabase As AcSmDatabase = GetSSDB(editor)
    '    Dim pStrOpts As acEdInp.PromptStringOptions = New acEdInp.PromptStringOptions(vbLf & "Путь для сохранения: ")
    '    pStrOpts.AllowSpaces = True
    '    Dim PrRes As acEdInp.PromptResult = editor.GetString(pStrOpts)
    '    If PrRes.Status = acEdInp.PromptStatus.OK Then
    '        If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
    '            sheetSetDatabase.LockDb(sheetSetDatabase)
    '            Dim Path As String = PrRes.StringResult
    '            Dim ss2 As IAcSmSheetSet = sheetSetDatabase.GetSheetSet
    '            Dim dstName As String = ss2.GetName()
    '            Dim dstFileName As String = sheetSetDatabase.GetFileName()
    '            'dstFileName = dstFileName.Replace("\", "\\") & "\\" & dstName
    '            Dim fi As FileInfo = New FileInfo(dstFileName)
    '            dstFileName = Path.Replace("\", "\\") & "\\" & fi.Name.Replace(".dst", "")
    '            'dstFileName = Path & "\" & fi.Name.Replace(".dst", "")
    '            Dim ComStr As String = "(command ""-АРХИВАЦИЯ"" """ & dstName & """ ""Создать"" """ & dstFileName & """)"
    '            'editor.WriteMessage(Environment.NewLine & ComStr)
    '            sheetSetDatabase.UnlockDb(sheetSetDatabase)
    '            acDoc.SendStringToExecute(ComStr & Environment.NewLine, True, True, True)
    '            'editor.Command("-АРХИВАЦИЯ", dstName, "Создать", dstFileName)
    '        End If
    '        'sheetSetManager.Close(sheetSetDatabase)
    '    End If
    '    'sheetSetManager.Close(sheetSetDatabase)
    'End Sub

    Public Function GetAllSubSet(wSSCol As IAcSmEnumComponent) As List(Of AcSmSubset)
        Dim CPV As IAcSmComponent = wSSCol.Next
        Dim rList As New List(Of AcSmSubset)
        Do While Not (CPV Is Nothing)
            Dim tname As String = CPV.GetTypeName
            If tname = "AcSmSubset" Then
                Dim wSubSet As AcSmSubset = CPV
                rList.Add(wSubSet)
                Dim subName As String = wSubSet.GetName
                If Not String.IsNullOrEmpty(subName) Then rList.AddRange(GetAllSubSet(wSubSet.GetSheetEnumerator))
            End If
            CPV = wSSCol.Next
        Loop
        Return rList
    End Function

    ''' <summary>
    ''' Сортировка листов в разделах
    ''' </summary>
    ''' <param name="wSS"> Раздел </param>
    ''' <remarks></remarks>
    Public Sub SortSheet(wSS As AcSmSubset)
        Dim sheetSetDatabase As AcSmDatabase = wSS.GetDatabase
        Dim wSSCol As IAcSmEnumComponent = wSS.GetSheetEnumerator
        Dim CPV As IAcSmComponent = wSSCol.Next
        Dim wSheet As AcSmSheet
        Dim wDict As New Dictionary(Of Integer, AcSmSheet)
        Dim sNmbr As String
        Dim iNmbr As Integer
        sheetSetDatabase.LockDb(sheetSetDatabase)
        Do While Not (CPV Is Nothing)
            Dim tname As String = CPV.GetTypeName
            If tname = "AcSmSheet" Then
                'editor.WriteMessage(Environment.NewLine & "AcSmSheet Name: " & CPV.GetName)
                wSheet = CPV
                sNmbr = wSheet.GetNumber
                If Integer.TryParse(sNmbr, iNmbr) Then
                    If Not wDict.ContainsKey(iNmbr) Then
                        wDict.Add(iNmbr, wSheet)
                        wSS.RemoveSheet(wSheet)
                    End If
                End If
            End If
            CPV = wSSCol.Next
        Loop
        Dim iList As List(Of Integer) = wDict.Keys.ToList()
        iList.Sort()
        iList.Reverse()
        For Each i As Integer In iList
            wSS.InsertComponent(wDict(i), Nothing)
        Next
        sheetSetDatabase.UnlockDb(sheetSetDatabase)
    End Sub

    ''' <summary>
    ''' Сортировка листов в разделах
    ''' </summary>
    ''' <remarks></remarks>
    <CommandMethod("SortSheet", CommandFlags.Interruptible)> _
    Public Sub SortSheet()
        Dim editor As Autodesk.AutoCAD.EditorInput.Editor = acApp.Application.DocumentManager.MdiActiveDocument.Editor()
        Dim sheetSetDatabase As AcSmDatabase = GetSSDB(editor)
        Dim rList As New List(Of AcSmSubset)
        If sheetSetDatabase IsNot Nothing Then
            Try
                If sheetSetDatabase.GetLockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                    'fRenameSubSet(tagName, nName, sheetSetDatabase.GetSheetSet().GetSheetEnumerator, sheetSetDatabase)
                    rList = GetAllSubSet(sheetSetDatabase.GetSheetSet().GetSheetEnumerator)
                    For Each SS As AcSmSubset In rList
                        SortSheet(SS)
                        'editor.WriteMessage(Environment.NewLine & "AcSmSubset Name: " + SS.GetName)
                        'Dim wSSCol As IAcSmEnumComponent = SS.GetSheetEnumerator
                        'Dim CPV As IAcSmComponent = wSSCol.Next
                        'Do While Not (CPV Is Nothing)
                        ' Dim tname As String = CPV.GetTypeName
                        'If tname = "AcSmSheet" Then
                        ' editor.WriteMessage(Environment.NewLine & "AcSmSheet Name: " & CPV.GetName)
                        'End If
                        'CPV = wSSCol.Next
                        'Loop
                    Next
                Else
                    editor.WriteMessage("AcSmDatabase is Lock")
                End If
                sheetSetManager.Close(sheetSetDatabase)
            Catch ex As System.Exception
                editor.WriteMessage("error: " & ex.ToString)
            End Try
        End If
    End Sub

End Class

Последний раз редактировалось trir, 31.05.2018 в 10:38.
trir на форуме  
 
Непрочитано 31.05.2018, 10:25
#111
Boxa

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


Цитата:
Сообщение от KEHT Посмотреть сообщение
Jmix, ты забросил развитие своей программы? Кто нибудь вообще пытается развивать нумерацию подшивок? Тут все так начиналось, и заглохло
Угу, заглохло, у самого производителя. не замечал я изменений в работе подшивок или новых инструментов для работы с ней от Autodesk.

По поводу автоматизации работы с подшивками, подшивка - слегка зашифрованный текстовый файл, алгоритм шифрования и де шифрования с ключами давно валяется в сети, соответственно автоматизировать можно что угодно, как угодно и на каком угодно языке, было бы желание.
У кого было желание и потребность давно это сделали, программа от Jmix и возня с VBA тут вообще не нужны.

trir, Вы пометьте, что это не VBA, a VB.NET, иначе будут вопросы как это vba запустить...
__________________
_бложиг
Boxa вне форума  
 
Непрочитано 31.05.2018, 10:47
#112
trir


 
Регистрация: 18.12.2010
Сообщений: 3,444


2013
trir на форуме  
 
Непрочитано 08.08.2019, 05:36
#113
allar8


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


Цитата:
Сообщение от trir Посмотреть сообщение
я для себя всё сделал

----- добавлено через ~26 мин. -----
код VB.NET
Цитата:
Сообщение от trir Посмотреть сообщение
2013
c префиксами я так понял не работает, только с целочисленными номерами?
В 2017 и 2020 акадах не будет работать?

Цитата:
Сообщение от Boxa Посмотреть сообщение
У кого было желание и потребность давно это сделали
Но видимо только для себя?) Ведь многие сделать для себя не умеют, но им тоже интересно)

Последний раз редактировалось allar8, 08.08.2019 в 05:59.
allar8 вне форума  
 
Непрочитано 08.08.2019, 06:57
#114
trir


 
Регистрация: 18.12.2010
Сообщений: 3,444


Цитата:
Ведь многие сделать для себя не умеют, но им тоже интересно)
А они готовы за это заплатить?
trir на форуме  
 
Непрочитано 08.08.2019, 08:42
#115
VitalyAF

инженер
 
Регистрация: 19.07.2005
Россия
Сообщений: 2,289
Отправить сообщение для VitalyAF с помощью Skype™


Цитата:
А они готовы за это заплатить?
...много не заработаешь, благодарность пользователей - польза для души...
VitalyAF вне форума  
 
Непрочитано 08.08.2019, 08:54
#116
allar8


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


Цитата:
Сообщение от trir Посмотреть сообщение
А они готовы за это заплатить?
Я готов, но сами понимаете чисто символически) - сам на этом все равно не заработаю - все ради интереса.
И потом вопросы задавал с целью - стоит ли начинать осваивать VB.NET, т.к. нахожусь щаз на этапе начала освоения всего этого.
Мечусь между лиспом, С++ и vba.net. Но как говорится побежишь за двумя (в данном случае тремя)) зайцами ни одного не догонишь.
вот и спросил - мож на VB.NET сконцентрироваться ща. Потому что в данный момент тема с автонумерацией листов
подшивок мне наиболее интересна.
Я имею ввиду на базе того что у вас сделано - реально допилить для акадов 2017 и 2020 и префиксы добавить?
Ответы на эти вопросы возможно могли бы стать для меня отправной точкой сконцентрироваться ща на vba.net.
Сконцентрироваться - на данном этапе я имею ввиду научиться хотя бы готовый код использовать и компилировать если нужно.))). Пока только так)
allar8 вне форума  
 
Непрочитано 08.08.2019, 09:14
#117
VitalyAF

инженер
 
Регистрация: 19.07.2005
Россия
Сообщений: 2,289
Отправить сообщение для VitalyAF с помощью Skype™


Цитата:
Сообщение от allar8 Посмотреть сообщение
Мечусь между лиспом, С++ и vba.net.
Ставь на python не ошибёшься... )
VitalyAF вне форума  
 
Непрочитано 08.08.2019, 09:16
#118
allar8


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


Цитата:
Сообщение от VitalyAF Посмотреть сообщение
Ставь на python не ошибёшься... )
))) Слышал о нем. Но в моем случае пока рано на что то ставить)
allar8 вне форума  
 
Непрочитано 08.08.2019, 10:04
#119
trir


 
Регистрация: 18.12.2010
Сообщений: 3,444


лучше C#
задачу можно решить одной функцией

Цитата:
...много не заработаешь, благодарность пользователей - польза для души...
дело в мотивации, я для себя уже всё сделал и мне не интересно к этому возращатся.
У меня есть библиотека получше той, что лежит у меня на github'е - но так её выкладывть, стрёмно, нужно доделать, а мотивации на это нет...
trir на форуме  
 
Непрочитано 08.08.2019, 10:35
#120
allar8


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


Цитата:
Сообщение от trir Посмотреть сообщение
но так её выкладывть, стрёмно, нужно доделать, а мотивации на это нет...
Понимаю.
Но наверно вы и сами понимаете. Массово мало кто интересуется этой темой, т.к. большинство подшивками и не пользуются вовсе, чем и объясняется отсутствие развития со стороны Автодеска
Символическая благодарность одного человека в лице например меня, Вас все равно наверно не замотивирует)
Видимо о Вашем таланте знать будете только вы к сожалению, ну не спорю мож с кем и делились - они думаю Вам тоже благодарны.
Тут на этом деле вряд ли заработаешь - чисто энтузиазм и огромный интерес ко всему этому.
Вон разработчику реверса например как то удалось вроде поставить на поток свою программу и даже чего то наверно ему перепадает.
Но вознаграждение он берет со своей программы тож чисто символическое.
Так как даже в такой простой нужной и полезной программе как Реверс например, на мой взгляд, очень трудно разобраться рядовому пользователю, который не интересуется этим. А таких большинство.
Я убедился в этом когда пытался внедрить эту программу в своей конторе. Уж и настроил вроде все шаблоны - только бери да пользуйся. Один хрен никто не хочет хоть чуть чуть разобраться и понять - потому что у большинства нет интереса как автоматизированно печатать - интерес у большинства к деньгам)
Задачами мы тут интересуемся очень узконаправленными.

Последний раз редактировалось allar8, 08.08.2019 в 10:56.
allar8 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Нумерация листов из "менеджера подшивок"

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

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