[CDR 2017-2021] Штрихкод сделать чёрным, а не составным

  • Автор темы Автор темы izrukvruki
  • Дата начала Дата начала
izrukvruki

izrukvruki

Топикстартер
15 лет на форуме
Сообщения
1 877
Реакции
307
В Corel создаю штрихкод.
Экспортирую в pdf, но там черный цвет оказывается составным. Приходится экпортировать в серый или ч/б tif
Можно цвет сделать чисто черным? И можно ли этот ole-объект преобразовать в кривые (без растрирования, и последующей трассировке)?
 
izrukvruki сказал(а):
В Corel создаю штрихкод.
Экспортирую в pdf, но там черный цвет оказывается составным. Приходится экпортировать в серый или ч/б tif
Можно цвет сделать чисто черным? И можно ли этот ole-объект преобразовать в кривые (без растрирования, и последующей трассировке)?
Нажмите, чтобы раскрыть...
Можно и нужно. Вставляйте не как ole а как метафайл
 
И потом перекрасить не забыть...
 
izrukvruki сказал(а):
И можно ли этот ole-объект преобразовать в кривые (без растрирования, и последующей трассировке)?
Нажмите, чтобы раскрыть...
Отсюда
Код: 
Sub BarcodeToCurves()
    Dim OrigSelection As ShapeRange, bc As ShapeRange, sx#, sy#, s1 As Shape
    ActiveDocument.BeginCommandGroup ("BARCODE")
    On Error GoTo ErrHandler
    Optimization = True
    Set bc = ActivePage.FindShapes(, cdrOLEObjectShape)
    For Each s1 In bc
    If InStr(s1.OLE.FullName, "BARCODE") Then
      s1.GetPosition sx, sy
      s1.Cut
      ActiveLayer.PasteSpecial "Metafile"
      Set pastesel = ActiveSelectionRange
      pastesel.PositionX = sx
      pastesel.PositionY = sy
      pastesel.Ungroup
      For Each s In pastesel
      If s.ZOrder = pastesel.Count Then s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0): GoTo here
      s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
      If s.Type = cdrTextShape Then s.ConvertToCurves
here:
      Next s
      pastesel.CreateSelection
      pastesel.Group
      End If
      Next s1
      Optimization = False
      ActiveDocument.EndCommandGroup
ExitSub:
Optimization = False
ActiveWindow.Refresh
Exit Sub

ErrHandler:
MsgBox "Error occured: " & Err.Description
Resume ExitSub
End Sub
ищет на странице все OLE, в них выбирает шейпы с именем BARCODE,
вырезает в буфер, вставляет обратно где взял как метафайл,
перекрашивает в 0,0,0,100, кривит текст и группирует
...

и вот ещё было
 
Последнее редактирование:
  • Спасибо
Реакции: Bill Williamson, Haka3aTe/|b и izrukvruki
dastin сказал(а):
Отсюда
Код: 
Sub BarcodeToCurves()
    Dim OrigSelection As ShapeRange, bc As ShapeRange, sx#, sy#, s1 As Shape
    ActiveDocument.BeginCommandGroup ("BARCODE")
    On Error GoTo ErrHandler
    Optimization = True
    Set bc = ActivePage.FindShapes(, cdrOLEObjectShape)
    For Each s1 In bc
    If InStr(s1.OLE.FullName, "BARCODE") Then
      s1.GetPosition sx, sy
      s1.Cut
      ActiveLayer.PasteSpecial "Metafile"
      Set pastesel = ActiveSelectionRange
      pastesel.PositionX = sx
      pastesel.PositionY = sy
      pastesel.Ungroup
      For Each s In pastesel
      If s.ZOrder = pastesel.Count Then s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0): GoTo here
      s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
      If s.Type = cdrTextShape Then s.ConvertToCurves
here:
      Next s
      pastesel.CreateSelection
      pastesel.Group
      End If
      Next s1
      Optimization = False
      ActiveDocument.EndCommandGroup
ExitSub:
Optimization = False
ActiveWindow.Refresh
Exit Sub

ErrHandler:
MsgBox "Error occured: " & Err.Description
Resume ExitSub
End Sub
ищет на странице все OLE, в них выбирает шейпы с именем BARCODE,
вырезает в буфер, вставляет обратно где взял как метафайл,
перекрашивает в 0,0,0,100, кривит текст и группирует
...

и вот ещё было
Нажмите, чтобы раскрыть...
в 2019 вылетела программа... завтра в 2017 попробую.

А через спец.вставку вставляется кривыми - спасибо, большое.
Корел неперестает удивлять своими костылями - нельзя было как-то сразу вставлять кривыми
 
izrukvruki сказал(а):
завтра в 2017 попробую.
Нажмите, чтобы раскрыть...
наверное стоит код подрезать слегка ... чтобы работал только по выделению (штучно) ... не думаю что на странице массово надо править OLE-баркоды ... поиск по имени в 2019 меня уже слегка напрягает ... хотя в Х7 может будет не всё так плохо
 
2017 это не Х7
 
а так то да, то что выделено - нужно в кривые
 
izrukvruki сказал(а):
в 2019 вылетела программа... завтра в 2017 попробую.

А через спец.вставку вставляется кривыми - спасибо, большое.
Корел неперестает удивлять своими костылями - нельзя было как-то сразу вставлять кривыми
Нажмите, чтобы раскрыть...
Сразу кривыми - пропадает возможность редактирования, с другой стороны, ни разу не видел, чтобы кто-то баркод редактировал готовый
 
без цилиндра поиска OLE
Код: 
Option Explicit

Sub BarcodeToCurves()
    Dim pastesel As New ShapeRange, bc As Shape, sx#, sy#, s1 As Shape, s As Shape
    ActiveDocument.BeginCommandGroup ("BARCODE")
    Optimization = True
    Set bc = ActiveDocument.ActiveShape
      bc.GetPosition sx, sy
      bc.Cut
      ActiveLayer.PasteSpecial "Metafile"
      Set s1 = ActiveSelection
      s1.PositionX = sx
      s1.PositionY = sy
      pastesel.Add s1
      pastesel.UngroupAll
      For Each s In pastesel
      If s.Fill.UniformColor.RGBBlue = 255 And s.Fill.UniformColor.RGBRed = 255 And s.Fill.UniformColor.RGBGreen = 255 Then
      s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0)
      Else
      s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
      End If
      If s.Type = cdrTextShape Then s.ConvertToCurves
      Next s
      pastesel.CreateSelection
      pastesel.Group
      Optimization = False
      ActiveDocument.EndCommandGroup
ExitSub:
Optimization = False
ActiveWindow.Refresh
End Sub
 
  • Спасибо
Реакции: izrukvruki
В 2017 работает, благодарю!
 
А размеры не поменяет? У меня было такое - менялся размер после вклеивания bar-code. И я отдельной строкой размер устанавливал
 
zollinger сказал(а):
А размеры не поменяет?
Нажмите, чтобы раскрыть...
2019 - изменения есть - в сотые доли миллиметра

например
234,67*48,22 - баркод
234,66*48,258 - в кривых

но если исходный баркод маштабировать вручную, то макрос эти "безобразия" пресекает
и возвращает группу кривых в исходных размерах - т.е. без учета масштабирования
 
Последнее редактирование:
а, ну это пренебрежимо мало, конечно, у меня почему-то основательно меняло
 
Для ответа нужно войти/зарегистрироваться
Верх Низ