Script library

Hier diskutieren die Betatester von PhotoLine untereinander und mit den Entwicklern
Benutzeravatar
russellcottrell
Mitglied
Beiträge: 251
Registriert: Sa 26 Jul 2014 10:13
Wohnort: California

Script library

Beitrag von russellcottrell »

Hello; here is a test of a script library that wraps some complicated scripts into more user-friendly functions. Run caller.vbs and it loads library.vbs.

I get a weird “You have not enough memory” error off and on at the point of the LayerToRGB function; this happens whether it runs from the library or is hard-coded into the caller script. I have allotted 4GB of memory to PhotoLine and there are still many GB of RAM available, and the error sometimes happens and sometimes doesn’t, so I don’t know what is going on.

caller.vbs

Code: Alles auswählen

Option Explicit

Dim fontSize, fontColor

LoadLibrary "library.vbs"

NewImage PTRGB+PT16Bit, 900, 1500, 300, RGBColor(255, 255, 255, 255)

fontSize = (1/4)*docRes
Set fontColor = RGBColor(187, 0, 0, 255)

CreateTextLayer "Hello", "Palatino Linotype", fontSize, fontColor, _
  0, docRes, docSize(0), fontSize, PACenter

LayerToRGB(8)

Emboss 135, 12, fontSize/10, 16, 5, 0

doc.ActiveLayer = doc.ActiveLayer.Previous

FillShape RGBColor(204, 204, 204, 255), _
  Array((1/4)*docRes, docRes*0.9, docSize(0) - (1/4)*docRes, docRes*1.1 + fontSize)

Set doc = Nothing
Set pl = Nothing



Sub LoadLibrary(libraryFile)

Dim fso, scriptPath, scriptFile
Set fso = CreateObject("Scripting.FileSystemObject")
scriptPath = fso.GetAbsolutePathName(".")
scriptPath = fso.BuildPath(scriptPath, "Defaults")
scriptPath = fso.BuildPath(scriptPath, "Automation")
scriptPath = fso.BuildPath(scriptPath, libraryFile)
Set scriptFile = fso.OpenTextFile(scriptPath, 1)
ExecuteGlobal scriptFile.ReadAll
scriptFile.Close

End Sub
library.vbs

Code: Alles auswählen

Option Explicit

Dim pl, doc, docSize, docRes, docPath

'pictureType
Const PTGray = 0
Const PTRGB = 1
Const PT8Bit = 0
Const PT32Bit = 4096
Const PT16Bit = 8192
Const PTAlpha = 16384

'paragraphAlignment
Const PALeft = 0
Const PARight = 1
Const PACenter = 2
Const PAJustified = 4
Const PAJustifiedAll = 5

Const toRadians = 0.0174532925199433 '3.14159265358979/180



Set pl = CreateObject("PhotoLine.Application")
pl.Visible = True

Set doc = pl.ActiveDocument

If (Not doc Is Nothing) Then
  docSize = doc.Size
  docRes = doc.Resolution
  docPath = Mid(doc.Path, 1, InStrRev(doc.Path, "\"))
End If



Sub NewImage(pictureType, pictureWidth, pictureHeight, pictureResolution, pictureColor)

Dim image, Base64Str

base64Str = "UGhvdG8gTGluZSBBY3Rpb25zAAAAAQAAAAABAP+bAAAADEdyb3VwQWN0aW9uAAIAAAAAAAAAAHIC" & _
"AQAAAAEAAAAEAAAAAQAAAAMAAABYAAAAAQD/mwAAAA1JQ0NOZXdBY3Rpb24AAQIAAAAAAAAABgIB" & _
"/////wAAAAEAAAAEAAIAAAAAAAIAAAAGAQAAAAAAAAAAAwAAAAEAAAAABAAAAAFA//////////8A" & _
"AAABAAAAFv+bAAAAEFNldENvbG9yUHJvZmlsZQAAAAACAAAABAAAACL/////" 'set color profile

Set doc = CreateObject("PhotoLine.Document")
doc.DocumentMode = False
Set image = CreateObject("PhotoLine.Image")
image.InitPicture pictureType, Array(pictureWidth, pictureHeight), pictureColor
doc.RootLayer.Insert image, -1
doc.Resolution = pictureResolution
doc.DoOperation "Action", "Data", base64Str, "ShowDialog", True

docSize = doc.Size
docRes = doc.Resolution

End Sub



Sub CreateTextLayer(text, fontName, fontSize, fontColor, left, top, width, height, paragraphAlignment)

'fontSize:  pixels

Dim fontDict, paragraphDict, textLayer, aLayer, range
Set aLayer = doc.ActiveLayer

Set fontDict = CreateObject("PhotoLine.Dictionary")
fontDict.Add "FamilyName", fontName, "Size", fontSize

Set paragraphDict = CreateObject("PhotoLine.Dictionary")
paragraphDict.Add "Alignment", paragraphAlignment

Set textLayer = CreateObject("PhotoLine.Text")
textLayer.Text = text
range = Array(0, textLayer.TextLength)
textLayer.Origin = Array(left, top)
textLayer.Size = Array(width, height)
textLayer.SetAttribute range, "Color", fontColor
textLayer.SetAttribute range, "Font", fontDict
textLayer.SetAttribute range, "Paragraph", paragraphDict

aLayer.Parent.Insert textLayer, aLayer

doc.ActiveLayer = textLayer

End Sub



Sub LayerToRGB(bitDepth)

'converts the active layer to an RGB layer
'bitDepth 8, 16, 32

Dim hexStr

Select Case bitDepth
  Case 8
    bitDepth = "00"
  Case 16
    bitDepth = "20"
  Case 32
    bitDepth = "10"
End Select

hexStr = "50686f746f204c696e6520416374696f6e7300000001000000000100ff9b0000000e436f" & _
"6e76657274416374696f6e00020000000000000000120201000000010000000400000001" & _
"ffffffff000000010000000200010000000200000004" & _
bitDepth & _
"000000000000030000000400000003ffffffff"

doc.DoOperation "Action", "Data", hexStr

End Sub



Sub Emboss(direction, height, width, intensity, curve, mode)

'direction 0-360
'height 5-90
'width 0-100
'intensity 0-100
'curve 0-7 as below
'mode 0 = Unsharp, 1 = Shade
'pattern is Create From Intensity

Dim hexStr

direction = FloatToHex(direction * toRadians)

height = FloatToHex(height * toRadians)

width = ByteToHex(width)

intensity = FloatToHex(intensity)

Select Case curve
  Case 0
    curve = "000000000000000000000000200000000000200000000000200000000001200000000001" 'straight
  Case 1
    curve = "0000000000000000000000002afe0bc0ffff284121800000200000000001200000000001" 'straight raised
  Case 2
    curve = "00000000000000000000000029c55fc00000314ce400ffff200000000001200000000001" 'straight lowered
  Case 3
    curve = "000000000000200000000001200000000000200000000000200000000001000000000000" 'reversed
  Case 4
    curve = "00000000000020000000000129c55fc0000027598e000000200000000001000000000000" 'reversed raised
  Case 5
    curve = "0000000000002000000000012afe0bc0ffff2f7dbd00ffff200000000001000000000000" 'reversed lowered
  Case 6
    curve = "000000000000000000000000207d11800000200000000001200000000001000000000000" 'arch
  Case 7
    curve = "000000000000200000000001207d11800000000000000000200000000001200000000001" 'U
End Select

mode = ByteToHex(mode)

hexStr = "50686f746f204c696e6520416374696f6e7300000001000000000100ff9b0000000d456d" & _
"626f7373416374696f6e00010100000000000000120201000000010000000400000001ff" & _
"ffffff00000001000000e40001000000000000000000020000000000010000008c010000" & _
"0000050000000200" & _
mode & _
"0000000000000006" & _
direction & _
"0000000100000006" & _
height & _
"0000000200000006" & _
intensity & _
"0000000300000004000000" & _
width & _
"000000040000003e01000000000000000002000100000001000000260003" & _
curve & _
"ffffffffffffffff00000002000000360100000000000000000200030000000100000006" & _
"3243f6c0000000000002000000040000000300000003000000040000000affffffffffff" & _
"ffffffffffff"

doc.DoOperation "Action", "Data", hexStr

End Sub



Function FloatToHex(num)
Dim sign, exponent, expStr, mantissa, manStr, hexStr
If num = 0 Then
  hexStr = "000000000000"
Else
  sign = Sgn(num)
  num = Abs(num)
  exponent = Int(Log(num) / Log(2)) + 1
  expStr = exponent
  If expStr < 0 Then
    expStr = &H10000 + expStr
  End If
  expStr = Hex(expStr)
  expStr = String(4-Len(expStr), "0") & expStr
  mantissa = Int(sign * (num / (2^exponent)) * (2^30))
  manStr = Hex(mantissa)
  hexStr = LCase(manStr & expStr)
End If
FloatToHex = hexStr
End Function

Function ByteToHex(num)
ByteToHex = Right("0" & Hex(num), 2)
End Function

Function LongToHex(num)
ByteToHex = Right("0000000" & Hex(num), 2)
End Function

Function PadString(str, n)
PadString = String(n - Len(str), "0") & str
End Function



Function RGBColor(rr, gg, bb, alpha)

'rr, gg, bb, alpha 0-255

Dim color

Set color = CreateObject("PhotoLine.Color")
color.Model = 1
color.Values = Array(rr/255, gg/255, bb/255, alpha/255)

Set RGBColor = color

End Function



Sub FillShape(color, ByRef pointsArray)

'fills a shape in the active layer with a color
'points array is a list of points:  x0, y0, x1, y1, etc.
'2 points determine the diagonals of a rectangle; more than 2 trace out a polygon

Dim aLayer, vLayer, i

Set aLayer = doc.ActiveLayer
Set vLayer = CreateObject("PhotoLine.Vector")

vLayer.FillColor(0) = color
vLayer.LineColor(0) = Array(0, 0, 0, 0)

If UBound(pointsArray) = 3 Then

  vLayer.InsertPoints 0, 0, Array(pointsArray(0), pointsArray(1), pointsArray(2), pointsArray(1), _
    pointsArray(2), pointsArray(3), pointsArray(0), pointsArray(3))

Else

  vLayer.InsertPoints 0, 0, Array(pointsArray(0), pointsArray(1))

  For i=2 to UBound(pointsArray) Step 2
    vLayer.InsertPoints -1, 1, Array(pointsArray(i), pointsArray(i+1))
  Next

End If

aLayer.Parent.Insert vLayer, aLayer
doc.Merge Array(aLayer, vLayer)

End Sub
Zuletzt geändert von russellcottrell am Mi 07 Nov 2018 19:10, insgesamt 2-mal geändert.
Martin Huber
Entwickler
Entwickler
Beiträge: 4159
Registriert: Di 19 Nov 2002 15:49

Re: Script library

Beitrag von Martin Huber »

The LoadLibrary approach is very interesting. This would allow the creation of a script containing constants for layer types, image types, ... This way one would no longer have to use magic numbers, but could use meaningful constant names instead.

A side note to your FillShape function: In the else-block it should be possible to just do a

vLayer.InsertPoints 0, 0, pointsArray

The last point for closing the path shouldn't be necessary. If you need that point, because you want to use the vector layer later on, you could do a:
vLayer.InsertPoints -1, 1, Array(pointsArray(0), pointsArray(1))

The "-1" means "append the point".

Martin
Benutzeravatar
russellcottrell
Mitglied
Beiträge: 251
Registriert: Sa 26 Jul 2014 10:13
Wohnort: California

Re: Script library

Beitrag von russellcottrell »

I edited the scripts and added constants for the parameters. Also the missing polygon point was because I thought the first one needed to be InsertPoints 0, 0, but they all need to be InsertPoints 0, 1.

I tried and tried to get a named array to work for the points but “vLayer.InsertPoints 0, 0, pointsArray” just doesn’t work. The way I did it is the only way I could find to use an arbitrary number of points.
Benutzeravatar
russellcottrell
Mitglied
Beiträge: 251
Registriert: Sa 26 Jul 2014 10:13
Wohnort: California

Re: Script library

Beitrag von russellcottrell »

constants.vbs

Code: Alles auswählen

'Alignment
Const AlignDefault = 0
Const AlignToPixels = 1
Const AlignDont = 2

'BarcodeType
Const BarcodeI25 = 0
Const BarcodeEAN8 = 1
Const BarcodeEAN13 = 2
Const BarcodeUPCA = 3
Const BarcodeUPCE = 4
Const BarcodeISBN = 5
Const BarcodeC39 = 6
Const BarcodeEAN128 = 7
Const BarcodeC93 = 8
Const BarcodeC128 = 9
Const BarcodeQR = 10
Const BarcodeC39E = 11

'BlendMode
Const BMNormal = 0
Const BMMultiply = 1
Const BMDissolve = 2
Const BMScreen = 3
Const BMOverlay = 4
Const BMSoftLight = 5
Const BMHardLight = 6
Const BMColorDodge = 7
Const BMColorBurn = 8
Const BMDarken = 9
Const BMLighten = 10
Const BMDifference = 11
Const BMExclusion = 12
Const BMLinearDodge = 13
Const BMRemove = 14
Const BMLinearBurn = 15
Const BMHardMix = 16
Const BMLinearLight = 17
Const BMVividLight = 18
Const BMPinLight = 19
Const BMLighterColor = 20
Const BMDarkerColor = 21
Const BMSubtract = 22
Const BMDivide = 23
Const BMHue = 24
Const BMSaturation = 25
Const BMColor = 26
Const BMLuminance = 27

'BoundsType
Const BTGeometric = 0
Const BTLayout = 1
Const BTAlignment = 2
Const BTContent = 3

'CloseOption
Const COSave = 0
Const CODontSave = 1
Const COAsk = 2

'CoordinateSystem
Const CSPage = 0
Const CSGroup = 1
Const CSLayer = 2

'ColorModel
Const CMGray = 0
Const CMRGB = 1
Const CMCMYK = 2
Const CMLab = 10
Const CMHIS = 11
Const CMHSV = 12

'ColorSpaceMode
Const CSMNative = 0
Const CSMHIS = 1
Const CSMHSV = 2
Const CSMLab = 3
Const CSMRGB = 4
Const CSMCYMK = 5
Const CSMGray = 6

'CurveType
Const CTBezier = 0
Const CTSpline = 1
Const CTLagrange = 2
Const CTLinear = 3

'EXIFPreviewMode
Const EPMAlways = 0
Const EPMKeepExisting = 1
Const EPMNever = 2

'EXRCompression
Const ECNone = 0
Const ECRLE = 1
Const ECZIP = 2
Const ECZIPBlock16 = 3
Const ECPIZ = 4
Const ECPXR24 = 5
Const ECB44 = 6
Const ECB44A = 7

'GradientInterpolation
Const GILinear = 0
Const GICubic = 1

'GradientSpread
Const GIContinue = 0
Const GIReflect = 1
Const GIRepeat = 2

'GradientType
Const GTLinear = 0
Const GTCircle = 1
Const GTRadial = 2
Const GTRadialFull = 3

'InterpolationMode
Const IMNextPixel = 0
Const IMBilinear = 1
Const IMLanczos3 = 2
Const IMLanczos8 = 4
Const IMMitchellNetravali = 5
Const IMCatmullRom = 6
Const IMCubicSpline = 7
Const IMLiquid = 8

'LayerCreateDocumentFlags
Const LCDInvisible = 1

'LayerType
Const LTImage = 1
Const LTVector = 2
Const LTText = 4
Const LTGroup = 8
Const LTVirtualCopy = 16
Const LTPlaceholder = 32

'LineStyleAlignment
Const LSAAlignCenter = 0
Const LSAAlignInside = 1
Const LSAAlignOutside = 2

'LineStyleCap
Const LSCButtCap = 0
Const LSCRoundCap = 1
Const LSCSquareCap = 2
Const LSCArrowCap = 128

'LineStyleJoin
Const LSJMiterJoin = 0
Const LSJRoundJoin = 1
Const LSJBevelJoin = 2

'MakeSelectionMode
Const MSMSet = 0
Const MSMAdd = 1
Const MSMSub = 2
Const MSMIntersect = 3

'NoiseType
Const NTNone = 0
Const NTTurbulence = 1
Const NTFractalSum = 2
Const NTNoise = 3

'ParagraphAlignment
Const PALeft = 0
Const PARight = 1
Const PACenter = 2
Const PAJustified = 4
Const PAJustifiedAll = 5

'ParagraphRegister
Const PRNone = 0
Const PRWholeParagraph = 1
Const PRFirstLine = 2

'PDFColorMode
Const PDFDocument = 0
Const PDFCMYK = 1
Const PDFGray = 2
Const PDFX1a = 3
Const PDFX3 = 4

'PDFCompressionMode
Const PDFFlate = 0
Const PDFJPEGHighQuality = 1
Const PDFJPEGMediumQuality = 2
Const PDFJPEGLowQuality = 3
Const PDFFlateFast = 4
Const PDFUncompressed = 5

'PDFFontEmbedding
Const PDFNoEmbedding = 0
Const PDFEmbedOptionalVector = 1
Const PDFEmbed = 2
Const PDFConvertToVector = 3

'PDFTransparencyMode
Const PDFReplaceWithBackground = 0
Const PDFDitherBayer = 1
Const PDFDitherCoarse = 2
Const PDFDitherVertical = 3
Const PDFDitherHorizontal = 4
Const PDFDitherFine = 5
Const PDFDitherOrdered = 6
Const PDFDitherOrderedFat = 7
Const PDFDither45 = 8
Const PDFDitherThreshold = 8
Const PDFFullTransparency = 1000

'PictureType
Const PTGray = 0
Const PTRGB = 1
Const PTCMYK = 2
Const PTBitmap = 3
Const PTLab = 10
Const PTMask = 255
Const PT8Bit = 0
Const PT32Bit = 4096
Const PT16Bit = 8192
Const PTAlpha = 16384

'Quality
Const QualityDefault = 0
Const QualityAntialias = 1
Const QualityNoAntialias = 2

'RenderingIntent
Const RIAutomatic = -1
Const RIPerceptual = 0
Const RIRelativeColorimetric = 1
Const RISaturation = 2
Const RIAbsoluteColorimetric = 4

'ResizeMode
Const ResizeNormal = 0
Const ResizeResize = 1
Const ResizeFormula = 2

'ResizeHorizontalAlignment
Const ResizeLeft = 0
Const ResizeRight = 1
Const ResizeHorizontalCentered = 2
Const ResizeHorizontalAbsolute = 3

'ResizeVerticalAlignment
Const ResizeTop = 0
Const ResizeBottom = 1
Const ResizeVerticalCentered = 2
Const ResizeVerticalAbsolute = 3

'ScaleMode
Const SMNormal = 0
Const SMDPI = 1
Const SMPercent = 2
Const SMWidth = 3
Const SMHeight = 4
Const SMFit = 5
Const SMUnused = 6
Const SMFormula = 7

'SVGCompressionMode
Const SVGPNGFast = 0
Const SVGPNGStrong = 1
Const SVGJPEGLow = 2
Const SVGJPEGMid = 3
Const SVGJPEGHigh = 4

'TabType
Const TTLeft = 0
Const TTRight = 1
Const TTCentered = 2
Const TTDecimal = 3

'TextVerticalAlignment
Const TVATop = 0
Const TVACenter = 1
Const TVABottom = 2

'VectorPointType
Const VPTMoveTo = 0
Const VPTLineTo = 1
Const VPTCurveTo = 2
Const VPTTypeMask = 3
Const VPTIndexMask = 12
Const VPTIndexShift = 2
Const VPTSelected = 128

Const ToRadians = 0.0174532925199433 '3.14159265358979/180
I found a typo; I think
LSCButtCap = 1
should be
LSCRoundCap = 1

Also, I took the liberty of prefixing CM to the color models:
CMGray = 0
CMRGB = 1
CMCMYK = 2
CMLab = 10
CMHIS = 11
CMHSV = 12
Martin Huber
Entwickler
Entwickler
Beiträge: 4159
Registriert: Di 19 Nov 2002 15:49

Re: Script library

Beitrag von Martin Huber »

russellcottrell hat geschrieben: So 04 Nov 2018 05:35I get a weird “You have not enough memory” error off and on at the point of the LayerToRGB function; this happens whether it runs from the library or is hard-coded into the caller script. I have allotted 4GB of memory to PhotoLine and there are still many GB of RAM available, and the error sometimes happens and sometimes doesn’t, so I don’t know what is going on.
Are you using the 32 or the 64 bit version?

Martin
Martin Huber
Entwickler
Entwickler
Beiträge: 4159
Registriert: Di 19 Nov 2002 15:49

Re: Script library

Beitrag von Martin Huber »

russellcottrell hat geschrieben: Mo 05 Nov 2018 22:34I found a typo; I think
LSCButtCap = 1
should be
LSCRoundCap = 1
Yes, the documentation is wrong there. I will fix that.
russellcottrell hat geschrieben: Mo 05 Nov 2018 22:34Also, I took the liberty of prefixing CM to the color models:
CMGray = 0
CMRGB = 1
CMCMYK = 2
CMLab = 10
CMHIS = 11
CMHSV = 12
I changed that, too. This is more consistent with the other constants.

Martin
Martin Huber
Entwickler
Entwickler
Beiträge: 4159
Registriert: Di 19 Nov 2002 15:49

Re: Script library

Beitrag von Martin Huber »

russellcottrell hat geschrieben: Mo 05 Nov 2018 19:37 I edited the scripts and added constants for the parameters. Also the missing polygon point was because I thought the first one needed to be InsertPoints 0, 0, but they all need to be InsertPoints 0, 1.
The first point in a path should be a VPTMoveTo (0).
russellcottrell hat geschrieben: Mo 05 Nov 2018 19:37I tried and tried to get a named array to work for the points but “vLayer.InsertPoints 0, 0, pointsArray” just doesn’t work.
Strange. The sample "NewVector.vbs" creates a rectangular path with this line:

vector.InsertPoints 0, 0, Array(0, 0, size(0), 0, size(0), size(1), 0, size(1), 0, 0)

The array here should be equivalent to your pointsArray.

Martin
Benutzeravatar
russellcottrell
Mitglied
Beiträge: 251
Registriert: Sa 26 Jul 2014 10:13
Wohnort: California

Re: Script library

Beitrag von russellcottrell »

Are you using the 32 or the 64 bit version?
21.40B5, 64-bit, Windows 7, Intel i5-4440, 3.10GHz, 8GB RAM (my medium-sized computer).

If you change NewVector.vbs to (defining the array first)

Code: Alles auswählen

Dim vArray
vArray = array(0, 0, size(0), 0, size(0), size(1), 0, size(1), 0, 0)
vector.InsertPoints 0, 0, vArray
the points are not drawn.

Irregular polygons tend to miss the first point when drawing or merging the layer. This

Code: Alles auswählen

vArray = array(0, 0, 100, 0, 100, 110, 0, 120)
vector.InsertPoints 0, 0, Array(vArray(0), vArray(1))
For i=2 to UBound(vArray) Step 2
  vector.InsertPoints 0, 1, Array(vArray(i), vArray(i+1))
Next
skips the first point.

This (added the closing point)

Code: Alles auswählen

vArray = array(0, 0, 100, 0, 100, 110, 0, 120, 0, 0)
vector.InsertPoints 0, 0, Array(vArray(0), vArray(1))
For i=2 to UBound(vArray) Step 2
  vector.InsertPoints 0, 1, Array(vArray(i), vArray(i+1))
Next
draws correctly, but the first point is lost when merging the layer.

This (all 0, 1)

Code: Alles auswählen

vArray = array(0, 0, 100, 0, 100, 110, 0, 120, 0, 0)
For i=0 to UBound(vArray) Step 2
  vector.InsertPoints 0, 1, Array(vArray(i), vArray(i+1))
Next
works correctly, with or without the closing point.
Benutzeravatar
russellcottrell
Mitglied
Beiträge: 251
Registriert: Sa 26 Jul 2014 10:13
Wohnort: California

Re: Script library

Beitrag von russellcottrell »

On an unrelated note, is there a way to draw a circle/ellipse with scripting? It doesn’t look like it even records as an action.
Martin Huber
Entwickler
Entwickler
Beiträge: 4159
Registriert: Di 19 Nov 2002 15:49

Re: Script library

Beitrag von Martin Huber »

russellcottrell hat geschrieben: Di 06 Nov 2018 21:58 If you change NewVector.vbs to (defining the array first)

Code: Alles auswählen

Dim vArray
vArray = array(0, 0, size(0), 0, size(0), size(1), 0, size(1), 0, 0)
vector.InsertPoints 0, 0, vArray
the points are not drawn.
Yes, you are right. I will fix that.
russellcottrell hat geschrieben: Di 06 Nov 2018 21:58Irregular polygons tend to miss the first point when drawing or merging the layer. This

Code: Alles auswählen

vArray = array(0, 0, 100, 0, 100, 110, 0, 120)
vector.InsertPoints 0, 0, Array(vArray(0), vArray(1))
For i=2 to UBound(vArray) Step 2
  vector.InsertPoints 0, 1, Array(vArray(i), vArray(i+1))
Next
skips the first point.

(...)
This code as well as your other versions invert the path direction because all points are inserted at index 0.

A correct version is:

Code: Alles auswählen

vArray = array(0, 0, 100, 0, 100, 110, 0, 120)
vector.InsertPoints 0, 0, Array(vArray(0), vArray(1))
For i=2 to UBound(vArray) Step 2
  vector.InsertPoints i / 2, 1, Array(vArray(i), vArray(i+1))
Next
Or you just use -1 as index parameter which always appends at the end:

Code: Alles auswählen

vArray = array(0, 0, 100, 0, 100, 110, 0, 120)
vector.InsertPoints -1, 0, Array(vArray(0), vArray(1))
For i=2 to UBound(vArray) Step 2
  vector.InsertPoints -1, 1, Array(vArray(i), vArray(i+1))
Next
Martin
Benutzeravatar
russellcottrell
Mitglied
Beiträge: 251
Registriert: Sa 26 Jul 2014 10:13
Wohnort: California

Re: Script library

Beitrag von russellcottrell »

Thank you; I was unclear what index referred to.
Martin Huber
Entwickler
Entwickler
Beiträge: 4159
Registriert: Di 19 Nov 2002 15:49

Re: Script library

Beitrag von Martin Huber »

russellcottrell hat geschrieben: Di 06 Nov 2018 22:01 On an unrelated note, is there a way to draw a circle/ellipse with scripting? It doesn’t look like it even records as an action.
Just by simulating it by 4 beziers. And a generic ellipse is created most easily by transforming a circle.
The following code creates an ellipse having the size of the document.

Code: Alles auswählen

Dim pl
Dim doc

Set pl = CreateObject("PhotoLine.Application")

pl.Visible = True

Set doc = pl.ActiveDocument
If Not doc Is Nothing Then
	Dim	size
	Dim	vector

	size = doc.Size
	Set vector = CreateObject("PhotoLine.Vector")

	size(0) = size(0) * 0.5
	size(1) = size(1) * 0.5
	' create circle path located at (0, 0)
	points = CreateCirclePath(0, 0, size(0))
	vector.InsertPoints -1, 0, Array(points(0), points(1))
	For i=2 to UBound(points) Step 6
		vector.InsertPoints -1, 2, Array(points(i), points(i+1), points(i+2), points(i+3), points(i+4), points(i+5))
	Next
	' scale the height of the circle to the height of the document (GetScaleMatrix)
	' and move it to the center of the document (GetTranslationMatrix())
	vector.MatrixToPage = pl.GetScaleMatrix(1, size(1) / size(0)).Concatenate(pl.GetTranslationMatrix(size(0), size(1)))
	layer.Parent.Insert vector, layer
End If

Function CreateCirclePath(x, y, radius)
	Dim points(25)
	Dim	controlLength
	
	controlLength = radius * 0.55191502449
	
	points(0) = x - radius
	points(1) = y
	points(2) = points(0)
	points(3) = y - controlLength
	
	points(4) = x - controlLength
	points(5) = y - radius
	points(6) = x
	points(7) = points(5)
	points(8) = x + controlLength
	points(9) = points(5)
	
	points(10) = x + radius
	points(11) = y - controlLength
	points(12) = points(10)
	points(13) = y
	points(14) = points(10)
	points(15) = y + controlLength
	
	points(16) = x + controlLength
	points(17) = y + radius
	points(18) = x
	points(19) = points(17)
	points(20) = x - controlLength
	points(21) = points(17)

	points(22) = x - radius
	points(23) = y + controlLength
	points(24) = points(22)
	points(25) = y
	
	CreateCirclePath = points
End Function
Martin
Benutzeravatar
russellcottrell
Mitglied
Beiträge: 251
Registriert: Sa 26 Jul 2014 10:13
Wohnort: California

Re: Script library

Beitrag von russellcottrell »

Some more possible typos:

The following

CMLab = 10
CMHIS = 11
CMHSV = 12

seems to actually be

CMHIS = 10
CMHSV = 11
CMLab = 12

These look out of place or have duplicates:

Const LSCArrowCap = 128 (maybe)

Const PDFDither45 = 8
Const PDFDitherThreshold = 8
Const PDFFullTransparency = 1000

Const VPTCurveTo = 2
Const VPTTypeMask = 3
Const VPTIndexMask = 12
Const VPTIndexShift = 2
Const VPTSelected = 128
Martin Huber
Entwickler
Entwickler
Beiträge: 4159
Registriert: Di 19 Nov 2002 15:49

Re: Script library

Beitrag von Martin Huber »

russellcottrell hat geschrieben: Fr 09 Nov 2018 03:07CMLab = 10
CMHIS = 11
CMHSV = 12

seems to actually be

CMHIS = 10
CMHSV = 11
CMLab = 12
I fixed that.
russellcottrell hat geschrieben: Fr 09 Nov 2018 03:07These look out of place or have duplicates:

Const LSCArrowCap = 128 (maybe)
What's wrong with that?
russellcottrell hat geschrieben: Fr 09 Nov 2018 03:07Const PDFDither45 = 8
Const PDFDitherThreshold = 8
Const PDFFullTransparency = 1000
I fixed that. The enumeration should start with "PDFReplaceWithBackground = -1". This way PDFDither45 will become 7.
russellcottrell hat geschrieben: Fr 09 Nov 2018 03:07Const VPTCurveTo = 2
Const VPTTypeMask = 3
Const VPTIndexMask = 12
Const VPTIndexShift = 2
Const VPTSelected = 128
I don't see anything wrong here.

Martin
Benutzeravatar
russellcottrell
Mitglied
Beiträge: 251
Registriert: Sa 26 Jul 2014 10:13
Wohnort: California

Re: Script library

Beitrag von russellcottrell »

There is a duplicate:
Const VPTCurveTo = 2
Const VPTIndexShift = 2