[lidalynch]

Добрый день!

В чертеже есть подписи, образованные в блок (синее выделение). Необходимо буквенный текст отделить от значений (красные рамки как произошло, зеленая рамка как надо сделать). В ручную конечно можно просто сдвигать текст, но когда в чертеже таких моментов более 100, еще и чертеж не один, весьма затруднительно. Возможно есть какая то команда "исключить наложение текста" (?)

Буду признательна, если подскажете.

Фото прилагаю

[Dinoxromniy]

Сообщение от lidalynch Фото прилагаю

Не приложили, да в общем-то и не надо - лучше приложите чертеж в dwg, или кусок чертежа в dwg, если данные секретные.

[lidalynch]

Сообщение от Dinoxromniy Не приложили, да в общем-то и не надо - лучше приложите чертеж в dwg, или кусок чертежа в dwg, если данные секретные.

Ссылка удалилась...

Прикрепляю файл и фото на всякий случай

[Кулик Алексей aka kpblc]

Это не просто тексты, а атрибуты блоков. Плюс отсутствующие шрифты.
Так что а) затребовать нужные шрифты; б) при необходимости - зайти в редактор блоков и растащить атрибуты; в) выполнить _.attsync
Хотя думаю, что просто наличие шрифтов уже спасет ситуацию.
Offtop: К вопросу о том, как отдавать чертежи.

[lidalynch]

Сообщение от Кулик Алексей aka kpblc Хотя думаю, что просто наличие шрифтов уже спасет ситуацию.

Можно ли как то из чертежа узнать, какие шрифты отсутствуют и самостоятельно подгрузить их из интернета ?

[Dinoxromniy]

Сообщение от Кулик Алексей aka kpblc при необходимости - зайти в редактор блоков и растащить атрибуты;

Дык каждый блок насколько я вижу - уникален, это только если программно эти блоки раздвигать, не будешь же все 100 экземпляров вручную менять...

[Кулик Алексей aka kpblc]

Сообщение от lidalynch Можно ли как то из чертежа узнать, какие шрифты отсутствуют и самостоятельно подгрузить их из интернета ?

Можно. В окне текстовых стилей показывается, для каких стилей нет шрифтов. И вообще, по ссылке я рассказывал, что и как надо запаковывать, чтоб подобных проблем потом ни у кого не было.

----- добавлено через ~8 мин. -----

Сообщение от Dinoxromniy Дык каждый блок насколько я вижу - уникален, это только если программно эти блоки раздвигать, не будешь же все 100 экземпляров вручную менять...

Ну да, описаний блоков (я имею в виду уникальных) больше 300 штук. Так что я бы запрашивал шрифты

[Oleg T]

Большинство блоков - по одной вставке, атрибуты однострочные.
Так что шрифты и синхронизация сильно не помогут.
Назначил всем стилям Arial, высоту уменьшил до двух и сжатие - 0.6.
И всё равно надо растаскивать из-за наложения атрибутов (похоже, файл получен экспортом из какой-то спец. проги).

----- добавлено через ~5 мин. -----
Если допустимы сокращения, то разве что это может помочь.
Например, Проектная производительность на Проект. произв. и тому подобное.

[Dinoxromniy]

Сообщение от lidalynch Возможно есть какая то команда "исключить наложение текста"

Попробуйте код ниже, на вашем кусочке вроде бы сработал. Сильно не проверял, опять же на вашем кусочке вроде бы ненужный текст не трогает, но тут уже проверка за вами. Нужно запустить код и выделить мышкой нужный кусок документа, работать будет, если названия тегов везде организованы так, как в приложенном документе.

Код:

[Выделить все]

Sub att_ch()
    Const k = 3
    Dim i As Integer, mySset As AcadSelectionSet, j As Integer
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    
    For i = ThisDrawing.SelectionSets.Count - 1 To 0 Step -1
        If ThisDrawing.SelectionSets.Item(i).Name = "q1" Then ThisDrawing.SelectionSets.Item(i).Delete
    Next i

    ThisDrawing.SelectionSets.Add ("q1")
    Set mySset = ThisDrawing.SelectionSets.Item("q1")
    FilterType(0) = 0
    FilterData(0) = "INSERT"
    mySset.SelectOnScreen FilterType, FilterData

     Dim varAtrObj As Variant, varAttr As Variant, objblockRef As Variant, vrtAtrObj(0 To k) As Variant, strTxt(0 To k) As String, dblPnt(0 To k) As Variant, dblPnt2 As Variant, dblPnt3 As Variant
    
     For Each objblockRef In mySset
        i = 0
            varAttr = objblockRef.GetAttributes
            For Each varAtrObj In varAttr
                If LCase(varAtrObj.TagString) Like "exp_*" Then
                    strTxt(i) = varAtrObj.textString & " "
                    dblPnt(i) = varAtrObj.insertionPoint
                    Set vrtAtrObj(i) = varAtrObj
                    i = i + 1
                End If
            Next varAtrObj
            For j = 0 To i - 1
            dblPnt3 = dblPnt(j)
                For Each varAtrObj In varAttr
                    dblPnt2 = varAtrObj.insertionPoint
                    
                    If LCase(varAtrObj.TagString) Like "*[[]*[]]*" And Abs(dblPnt2(1) - dblPnt3(1)) < 1.8 Then
                        strTxt(j) = strTxt(j) & varAtrObj.textString & " "
                        strbuf = varAtrObj.TagString
                        varAtrObj.textString = " "
                        
                    End If
                Next varAtrObj
                
                
                For Each varAtrObj In varAttr
                    dblPnt2 = varAtrObj.insertionPoint
                    If (LCase(varAtrObj.TagString) Like "unit_*" Or strbuf Like "*[[]" & varAtrObj.TagString & "[]]") And Abs(dblPnt2(1) - dblPnt3(1)) < 1.8 Then
                        strTxt(j) = strTxt(j) & varAtrObj.textString & " "
                        varAtrObj.textString = " "
                       
                    End If
                Next varAtrObj
            Next j
            If i > 0 Then
            For j = i - 1 To 0 Step -1
            vrtAtrObj(j).textString = strTxt(j)
            
            Next j
            End If
            strbuf = ""
Next objblockRef



End Sub