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

[izrukvruki]

В Corel создаю штрихкод.
Экспортирую в pdf, но там черный цвет оказывается составным. Приходится экпортировать в серый или ч/б tif
Можно цвет сделать чисто черным? И можно ли этот ole-объект преобразовать в кривые (без растрирования, и последующей трассировке)?

 

[_MBK_]

В Corel создаю штрихкод.
Экспортирую в pdf, но там черный цвет оказывается составным. Приходится экпортировать в серый или ч/б tif
Можно цвет сделать чисто черным? И можно ли этот ole-объект преобразовать в кривые (без растрирования, и последующей трассировке)?

Можно и нужно. Вставляйте не как ole а как метафайл

 

[splxgf]

И можно ли этот ole-объект преобразовать в кривые

Копи-паст спешиал.

 

[_MBK_]

Сразу

паст спешиал.

как метафайл

 

[MrDesigner]

И потом перекрасить не забыть...

 

[dastin]

И можно ли этот 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, кривит текст и группирует
...

и вот ещё было

 

[izrukvruki]

Отсюда

Спойлер: не проверял

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 попробую.

А через спец.вставку вставляется кривыми - спасибо, большое.
Корел неперестает удивлять своими костылями - нельзя было как-то сразу вставлять кривыми

 

[dastin]

завтра в 2017 попробую.

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

 

[izrukvruki]

2017 это не Х7

 

[izrukvruki]

а так то да, то что выделено - нужно в кривые

 

[_MBK_]

в 2019 вылетела программа... завтра в 2017 попробую.

А через спец.вставку вставляется кривыми - спасибо, большое.
Корел неперестает удивлять своими костылями - нельзя было как-то сразу вставлять кривыми

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

 

[dastin]

без цилиндра поиска 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 работает, благодарю!

 

[zollinger]

А размеры не поменяет? У меня было такое - менялся размер после вклеивания bar-code. И я отдельной строкой размер устанавливал

 

[dastin]

А размеры не поменяет?

2019 - изменения есть - в сотые доли миллиметра

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

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

 

[zollinger]

а, ну это пренебрежимо мало, конечно, у меня почему-то основательно меняло