[CDR 2024] Векторизация qr-code

  • Автор темы Автор темы iKoolk
  • Дата начала Дата начала
КоньЕстДетей сказал(а):
Особенно когда генерят через бесплатные сайты, которые отсылают к себе с блоком рекламы, а чтоб попасть на задуманное надо еще кнопку найти.
Нажмите, чтобы раскрыть...
Вот как раз от клиентов такие несколько раз приходили! А я генерю векторные без всякого мусора.
 
lexter77 сказал(а):
А я генерю векторные без всякого мусора.
Нажмите, чтобы раскрыть...

Не по теме:
"Вот я вижу, вы всегда берете яйца по рубль тридцать. А я могу брать по девяносто, и они будут лучше, чем ваши. Ваши битые, а у меня будут целые, хорошие яички." (С) Стругацкие
 
  • Спасибо
Реакции: _MBK_
Векторю Корелом (пресетом Clipart). Потому что когда клиентам отправляешь на утверждение, например визитки, даже при макс. настройках качества, в случае растра, Акробат портит растровый код и клиент потом для проверки не может прочитать его. А когда векторныЙ, хоть в качестве web визитку отправляй на проверку. И pdf маленький по размеру.
 
1 бит вроде норм
 
lexter77 сказал(а):
Ну объяснить клиенту, что QR надо сгенерить заново, т.к. тот что он дал не соответствует требованиям. За все время ни разу не было случая, когда клиент после разъяснений продолжал настаивать, чтобы "все точечки совпали". главное, чтобы зашитая инфа осталась.

Ключевое , что надо донести до клиента: "ваш код не соответствует требованиям", я вам сделал новый, он гораздо лучше ) это работает.
Нажмите, чтобы раскрыть...
Еще раз скажу, зачастую имеем дело с посредниками, которые против, им по каким-то неведомым мне причинам нужен такой код. А еще бывают случаи, "но это не в нашем районе" (с) Кавказская пленница, когда приходится делать подделки этикеток, не нам конечно, кому-то. где все должно быть максимально похоже, причем бывает ситуация, когда даже не с джипегов (от других, простите, типографий), а со сканированных этикеток.
Я понимаю, что задача не тривиальная, но нужно именно в том воплощении, в котором я описал.
 
В копилку, в Illustrator без посторонней помощи можно получить векторный QR из растра с помощью Object -> Create object mosaic. Нужно просто задать сетку в соответствии с количеством ячеек QR кода в растре.
 
Cutter сказал(а):
В копилку, в Illustrator без посторонней помощи можно получить векторный QR из растра с помощью Object -> Create object mosaic. Нужно просто задать сетку в соответствии с количеством ячеек QR кода в растре.
Нажмите, чтобы раскрыть...
Спасибо, любопытная вещица, но не мощная (через пробел). Смотрите сами:
1727267523518.png


В центре исходный кваркод от клиента. справа результат Мозаики, слева результат скрипта.
 
  • Спасибо
Реакции: Sh
Согласен, это не кнопка "Сделать красиво". Но замечательно подходит для растровых исходников, которые заказчики получают на QR генераторах и затем приносят в работу.
 
Попробовал сделать ваш исходник, кропнул, сделал битмап и из него мозаику 33х33.
Есть отличия, но результат выглядит несколько иначе.
 

Вложения

  • trace.jpg
    trace.jpg
    19.7 КБ · Просм.: 46
Ну, то есть пришлось немножко его поколдовать. Просто скрипт сделал как есть. Я же не говорю, что Ваш путь плох. Он даже прекрасен, если бы не было скрипта, так что спасибо, что показали.
 
Болванка макроса по мотивам Иллюстраторовского скрипта
Код: 
Sub qr_trace()

  Set qr_bitmap = ActiveShape

  boostStart "QR Redraw"
  cnt = qr_get_count

  If (cnt - 21) Mod 4 <> 0 Then alert = vbCr & "РАЗМЕР НЕ СООТВЕТСТВУЕТ СТАНДАРТУ!!!" & vbCr & vbCr

  xxx = "Ваш qr-код похоже имеет размер: " & cnt & vbCr & _
      "размеры QR-кодов по стандарту:" & vbCr & alert & _
      "21 x 21, 25 x 25, 29 x 29, 33 x 33" & vbCr & _
      "37 x 37, 41 x 41, 45 x 45, 49 x 49" & vbCr & _
      "53 x 53, 57 x 57, 61 x 61, 65 x 65" & vbCr & _
      "69 x 69, 73 x 73, 77 x 77, 81 x 81" & vbCr & _
      "85 x 85, 89 x 89, 93 x 93, 97 x 97" & vbCr & _
      "101 x 101, ..., 177 x 177" & vbCr & _
      "введите размер одним числом:"

  qr_sz = InputBox(xxx, , cnt)
  If qr_sz = "" Then boostFinish: Exit Sub
  If (qr_sz - 21) Mod 4 <> 0 Then MsgBox "Размер не соответствует стандарту", vbExclamation: boostFinish: Exit Sub

  Dim sq As Shape, sr As New ShapeRange

  With qr_bitmap
    .SizeHeight = .SizeWidth
    sq_sz = .SizeWidth / qr_sz
    t = .TopY
    l = .LeftX
  End With
  d = sq_sz / 3

  For i = 1 To qr_sz
    For j = 0 To qr_sz - 1
      Set sq = ActiveVirtualLayer.CreateRectangle2(l + sq_sz * j, t - sq_sz * i, sq_sz, sq_sz)
      sq.Outline.Type = cdrNoOutline
      Set c = ActiveDocument.SampleColorInArea(sq.LeftX + d, sq.BottomY + d, sq.RightX - d, sq.TopY - d, 100, 100, cdrColorGray)
      If c.Gray > 100 Then
        sq.Delete
      Else
        sr.Add sq
      End If
      DoEvents
    Next j
  Next i
  Set sr = ActiveDocument.LogCreateShapeRange(sr)
  sr.Group

  sr.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)

  boostFinish
End Sub

Function qr_get_count() As Integer
  Dim s As Shape, sr As New ShapeRange
  p = ActiveShape.SizeHeight * 2 + ActiveShape.SizeWidth * 2
  
  Set dup = ActiveShape.Duplicate
  If dup.Bitmap.ResolutionX > 150 Then dup.Bitmap.Resample , , False, 150, 150 'загрубляем, т.к. на больших битмапах трейс может не запуститься
  Set sr = dup.Bitmap.Trace(cdrTraceLineArt, , , cdrColorGray, , 2, , False).Finish
  If sr.Shapes(1).Type = cdrGroupShape Then
    Set sr = sr.UngroupAllEx()
  End If

  For i = sr.Count To 1 Step -1
    If sr(i).Fill.UniformColor.Gray > 100 Or sr(i).Curve.Length > p Then sr(i).Delete: sr.Remove i
  Next i

  sr.Sort "@shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"

  qr_get_count = Round(sr.SizeWidth / (sr(1).SizeWidth / 7))
  
  dup.Delete
  sr.Shapes.All.Delete
End Function

Private Sub boostStart(Optional ByVal unDo As String = "")
  If unDo <> "" Then ActiveDocument.BeginCommandGroup unDo
  Optimization = True
  EventsEnabled = False
  ActiveDocument.SaveSettings
  ActiveDocument.PreserveSelection = False
End Sub
Private Sub boostFinish()
  ActiveDocument.EndCommandGroup
  ActiveDocument.PreserveSelection = True
  ActiveDocument.RestoreSettings
  EventsEnabled = True
  Optimization = False
  ActiveWindow.Refresh
  Refresh
End Sub
 
  • Спасибо
Реакции: zollinger
lev сказал(а):
Болванка макроса по мотивам Иллюстраторовского скрипта
Код: 
Sub qr_trace()

  Set qr_bitmap = ActiveShape

  boostStart "QR Redraw"
  cnt = qr_get_count

  If (cnt - 21) Mod 4 <> 0 Then alert = vbCr & "РАЗМЕР НЕ СООТВЕТСТВУЕТ СТАНДАРТУ!!!" & vbCr & vbCr

  xxx = "Ваш qr-код похоже имеет размер: " & cnt & vbCr & _
      "размеры QR-кодов по стандарту:" & vbCr & alert & _
      "21 x 21, 25 x 25, 29 x 29, 33 x 33" & vbCr & _
      "37 x 37, 41 x 41, 45 x 45, 49 x 49" & vbCr & _
      "53 x 53, 57 x 57, 61 x 61, 65 x 65" & vbCr & _
      "69 x 69, 73 x 73, 77 x 77, 81 x 81" & vbCr & _
      "85 x 85, 89 x 89, 93 x 93, 97 x 97" & vbCr & _
      "101 x 101, ..., 177 x 177" & vbCr & _
      "введите размер одним числом:"

  qr_sz = InputBox(xxx, , cnt)
  If qr_sz = "" Then boostFinish: Exit Sub
  If (qr_sz - 21) Mod 4 <> 0 Then MsgBox "Размер не соответствует стандарту", vbExclamation: boostFinish: Exit Sub

  Dim sq As Shape, sr As New ShapeRange

  With qr_bitmap
    .SizeHeight = .SizeWidth
    sq_sz = .SizeWidth / qr_sz
    t = .TopY
    l = .LeftX
  End With
  d = sq_sz / 3

  For i = 1 To qr_sz
    For j = 0 To qr_sz - 1
      Set sq = ActiveVirtualLayer.CreateRectangle2(l + sq_sz * j, t - sq_sz * i, sq_sz, sq_sz)
      sq.Outline.Type = cdrNoOutline
      Set c = ActiveDocument.SampleColorInArea(sq.LeftX + d, sq.BottomY + d, sq.RightX - d, sq.TopY - d, 100, 100, cdrColorGray)
      If c.Gray > 100 Then
        sq.Delete
      Else
        sr.Add sq
      End If
      DoEvents
    Next j
  Next i
  Set sr = ActiveDocument.LogCreateShapeRange(sr)
  sr.Group

  sr.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)

  boostFinish
End Sub

Function qr_get_count() As Integer
  Dim s As Shape, sr As New ShapeRange
  p = ActiveShape.SizeHeight * 2 + ActiveShape.SizeWidth * 2
 
  Set dup = ActiveShape.Duplicate
  If dup.Bitmap.ResolutionX > 150 Then dup.Bitmap.Resample , , False, 150, 150 'загрубляем, т.к. на больших битмапах трейс может не запуститься
  Set sr = dup.Bitmap.Trace(cdrTraceLineArt, , , cdrColorGray, , 2, , False).Finish
  If sr.Shapes(1).Type = cdrGroupShape Then
    Set sr = sr.UngroupAllEx()
  End If

  For i = sr.Count To 1 Step -1
    If sr(i).Fill.UniformColor.Gray > 100 Or sr(i).Curve.Length > p Then sr(i).Delete: sr.Remove i
  Next i

  sr.Sort "@shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"

  qr_get_count = Round(sr.SizeWidth / (sr(1).SizeWidth / 7))
 
  dup.Delete
  sr.Shapes.All.Delete
End Function

Private Sub boostStart(Optional ByVal unDo As String = "")
  If unDo <> "" Then ActiveDocument.BeginCommandGroup unDo
  Optimization = True
  EventsEnabled = False
  ActiveDocument.SaveSettings
  ActiveDocument.PreserveSelection = False
End Sub
Private Sub boostFinish()
  ActiveDocument.EndCommandGroup
  ActiveDocument.PreserveSelection = True
  ActiveDocument.RestoreSettings
  EventsEnabled = True
  Optimization = False
  ActiveWindow.Refresh
  Refresh
End Sub
Нажмите, чтобы раскрыть...
Интересно, спасибо, обязательно попробую
 
Тема "Векторизация qr-code", мой комментарий был о возможном решении в AI без дополнительных инструментов (Да, здесь CDR, но не создавать же новый топик), который даёт хороший результат в адекватном исходнике. Да, не потоковое решение, если вам нужно обрабатывать много кодов.
Даже пример iKoolk у меня получился читаемым векторным QR без особых усилий.
При не уплывшей геометрии вашего примера - вполне был бы шанс.
 
  • Спасибо
Реакции: Dmelnikov184 и Emergency
Cutter сказал(а):
Тема "Векторизация qr-code", мой комментарий был о возможном решении в AI без дополнительных инструментов (Да, здесь CDR, но не создавать же новый топик), который даёт хороший результат в адекватном исходнике. Да, не потоковое решение, если вам нужно обрабатывать много кодов.
Даже пример iKoolk у меня получился читаемым векторным QR без особых усилий.
При не уплывшей геометрии вашего примера - вполне был бы шанс.
Нажмите, чтобы раскрыть...
На приемлемого качества кодах, подсказанный Вами метод, работает великолепно. Спасибо
 
Для ответа нужно войти/зарегистрироваться
Верх Низ