[Solved] Draw: Cut PolyLine(s) to drawing area

jep · Post by **jep** » Tue Oct 29, 2019 5:36 pm

I've created a script to adjust imported PDF from a drawing application.
It has to cut off lines that extend beyond the edge of the drawing area/paper.
I want to cut them down to the paper size minus paper margins.

Just as the menu option "Intersect" that you can find in Draw under Modify->Shapes->Insersect

How can this be achieved?

Code: Select all

Type Insets
	left As Integer
	bottom as Integer
	right As Integer
	top As Integer
End Type

Sub Main
	Dim pageSize As New com.sun.star.awt.Size
	Dim margins As New Insets
	pageSize.Width = 297 * 100
	pageSize.Height = 210 * 100
	margins.left = 10 * 100
	margins.bottom = 10 * 100
	margins.right = 10 * 100
	margins.top = 10 * 100
	CleanUp( pageSize, margins )
End Sub

Sub PageSetup( drawPage As Object, pageSize As New com.sun.star.awt.Size, margins As Insets )

	If drawPage.Orientation = com.sun.star.view.PaperOrientation.LANDSCAPE Then
		drawPage.Width = pageSize.Height
		drawPage.Height = pageSize.Width
	Else
		drawPage.Width = pageSize.Width
		drawPage.Height = pageSize.Height
	End If
	If Not isNUll( margins.top ) Then
		drawPage.BorderTop = margins.top
	End If
	If Not isNUll( margins.bottom ) Then
		drawPage.BorderBottom = margins.bottom
	End If
	If Not isNUll( margins.left ) Then
		drawPage.BorderLeft = margins.left
	End If
	If Not isNUll( margins.right ) Then
		drawPage.BorderRight = margins.right
	End If
End Sub

Sub AddRectangle( drawPage As Object, rectangle As New com.sun.star.awt.Rectangle )
	Dim RectangelShape As Object
	Dim Point As New com.sun.star.awt.Point
	Dim Size As New com.sun.star.awt.Size
	Point.x = rectangle.X
	Point.y = rectangle.Y
	Size.Width = rectangle.Width
	Size.Height = rectangle.Height
	RectangleShape = ThisComponent.createInstance( "com.sun.star.drawing.RectangleShape" )
	'RectangleShape.Size = rectangle
	'RectangleShape.Position = rectangle
	RectangleShape.Size = Size
	RectangleShape.Position = Point
	drawPage.add( RectangleShape )
End Sub

Sub CleanUp( pageSize As New com.sun.star.awt.Size, margins As Insets )
	Dim Doc As Object
	Dim drawObject as Object
	Dim oDrawPage as Object   
	Dim rectangle As New com.sun.star.awt.Rectangle
	Dim c As Long
	Dim i As Long

	rectangle.X = margins.Top
	rectangle.Y = margins.Left
	rectangle.Width = pageSize.Width - margins.Left - margins.Right
	rectangle.Height = pageSize.Height - margins.Top - margins.Bottom
	Doc = ThisComponent
	For i = 0 to Doc.getDrawPages().Count - 1       
		oDrawPage = Doc.getDrawPages().getByIndex( i )
		PageSetup( oDrawPage, pageSize, margins )
		c = oDrawPage.count
		i = c
		Do While i >= 1
			drawobject = oDrawPage( i - 1 )
			if drawobject.ShapeType = "com.sun.star.drawing.LineShape" or drawobject.ShapeType = "com.sun.star.drawing.PolyLineShape" Then
				'if drawobject.Text.LineColor = RGB( 0, 0, 0 ) Then
				'    drawobject.LineColor = RGB( 158, 164, 255 )
				'else
				if drawobject.Text.LineColor = RGB( 0, 255, 255 ) Then
					drawobject.LineStyle = 1
					drawobject.LineWidth = 100
					drawobject.LineColor = 255
				elseif drawobject.Text.LineColor = RGB( 174, 6, 182 ) Then
					drawobject.LineDashName = "Fine Dashed (var)"
					drawobject.LineWidth = 80
				elseif drawobject.Text.LineColor = RGB( 158, 164, 255 ) Then
					oDrawPage.remove( drawObject )
					c = i
				endif
				AddRectangle( oDrawPage, rectangle )
			elseif drawobject.ShapeType = "com.sun.star.drawing.GraphicObjectShape" then
				'This part is also a problem as Bitmap images appear in black while "Transparent Bitmap" appear as they should except one Transparent Bitmap that show up as "Bitmap", strange.
				if drawobject.FillColor = 13625333 And drawobject.UINameSingular = "Bitmap" And c - i < 6 Then 
					oDrawPage.remove( drawObject )
					c = i
				endif
			endif
			i = i - 1
		Loop
	Next i
End Sub

Sub getRGB( lRGB As Long ) As String
	lColors = lRGB \ 256
	lRed = lColors \ 256
	lGreen = lColors - lRed * 256
	lBlue = lRGB - 256 * lColors
	getRGB = lRed & ", " & lGreen & ", " & lBlue
End Sub

jep · Post by **jep** » Wed Oct 30, 2019 2:30 pm

And here is the code... for now.

Code: Select all

Type Insets
   left As Long
   bottom as Long
   right As Long
   top As Long
End Type

Sub Main
   'Globalscope.BasicLibraries.LoadLibrary( "MRILib" )
   Dim pageSize As New com.sun.star.awt.Size
   Dim margins As New Insets
   pageSize.Width = 297 * 100
   pageSize.Height = 210 * 100
   margins.left = 4.2 * 100
   margins.bottom = 4.4 * 100
   margins.right = 4.4 * 100
   margins.top = 4.2 * 100
   CleanUp( pageSize, margins )
End Sub

Sub PageSetup( drawPage As Object, pageSize As New com.sun.star.awt.Size, margins As Insets )

   If pageSize.Width < pageSize.Height And drawPage.Orientation = com.sun.star.view.PaperOrientation.LANDSCAPE Then
		Dim lTemp As Long
		lTemp = pageSize.Height
		pageSize.Height = pageSize.Width
		pageSize.Width = lTemp
   EndIf
   
   drawPage.Width = pageSize.Width
   drawPage.Height = pageSize.Height
   'End If
   If Not isNUll( margins.top ) Then
      drawPage.BorderTop = margins.top
   End If
   If Not isNUll( margins.bottom ) Then
      drawPage.BorderBottom = margins.bottom
   End If
   If Not isNUll( margins.left ) Then
      drawPage.BorderLeft = margins.left
   End If
   If Not isNUll( margins.right ) Then
      drawPage.BorderRight = margins.right
   End If
End Sub

Sub AddRectangle( drawPage As Object, rectangle As New com.sun.star.awt.Rectangle ) As Object
   Dim RectangelShape As Object
   Dim Point As New com.sun.star.awt.Point
   Dim Size As New com.sun.star.awt.Size
   Point.x = rectangle.X
   Point.y = rectangle.Y
   Size.Width = rectangle.Width
   Size.Height = rectangle.Height
   RectangleShape = ThisComponent.createInstance( "com.sun.star.drawing.RectangleShape" )
   RectangleShape.Size = Size
   RectangleShape.Position = Point
   RectangleShape.FillStyle = com.sun.star.drawing.FillStyle.SOLID
   RectangleShape.FillTransparence = 100
   RectangleShape.FillColor = RGB( 0, 0, 0 )
   drawPage.add( RectangleShape )   
   AddRectangle = RectangleShape
End Sub

Sub BooleanSubtract( oDrawDoc As Object, oShape As Object )
	' Conversion into polygons and dissociation of objects with the dispatcher.
	dispatcher = createUnoService( "com.sun.star.frame.DispatchHelper" )
	oDrawDoc.currentController.select( oShape )                         ' Visible selection.
	dispatcher.executeDispatch( oDrawDoc.currentController.Frame, ".uno:Intersect", "", 0, array() )
End Sub

Sub CleanUp( pageSize As New com.sun.star.awt.Size, margins As Insets )
   Dim drawObject as Object
   Dim oDrawPage as Object
   Dim oRectangle as Object
   Dim rectangle As New com.sun.star.awt.Rectangle
   Dim c As Long
   Dim i As Long
	
			

   rectangle.X = margins.Top
   rectangle.Y = margins.Left
   rectangle.Width = pageSize.Width - margins.Left - margins.Right
   rectangle.Height = pageSize.Height - margins.Top - margins.Bottom
   For i = 0 to ThisComponent.getDrawPages().Count - 1       
      oDrawPage = ThisComponent.getDrawPages().getByIndex( i )
      PageSetup( oDrawPage, pageSize, margins )
      i = oDrawPage.count
      Do While i >= 1
         drawobject = oDrawPage( i - 1 )
         If drawobject.ShapeType = "com.sun.star.drawing.LineShape" Or drawobject.ShapeType = "com.sun.star.drawing.PolyLineShape" Then
            If drawobject.Text.LineColor = RGB( 158, 164, 255 ) Then
               oDrawPage.remove( drawObject )
            Else
	            If drawobject.Text.LineColor = RGB( 0, 255, 255 ) Then
	               drawobject.LineStyle = 1
	               drawobject.LineWidth = 100
	               drawobject.LineColor = 255
	            ElseIf drawobject.Text.LineColor = RGB( 174, 6, 182 ) Then
	               drawobject.LineDashName = "Fine Dashed (var)"
	               drawobject.LineWidth = 80
	            EndIf
	            Shapes = createUnoService("com.sun.star.drawing.ShapeCollection")
				Shapes.add( AddRectangle( oDrawPage, rectangle ) )
	            Shapes.add( drawobject )
		        BooleanSubtract( ThisComponent, Shapes )
				If Shapes.Count = 2 Then
			        oDrawPage.remove( Shapes.getByIndex( 1 ) )
			    EndIf
            EndIf
         ElseIf drawobject.ShapeType = "com.sun.star.drawing.GraphicObjectShape" Then
            'This part is also a problem as Bitmap images appear in black while "Transparent Bitmap" appear as they should except one Transparent Bitmap that show up as "Bitmap", strange.
            If drawobject.FillColor = RGB( 207, 231, 245 ) And drawobject.UINameSingular = "Bitmap" Then
               Dim bmp() As Byte
               bmp = drawobject.GraphicObjectFillBitmap.getDIB()
			   If 0 = bmp( LBound( bmp ) + 1078 ) Then
	               oDrawPage.remove( drawObject )
               EndIf
               c = i
            EndIf
         EndIf
         i = i - 1
      Loop
   Next i
End Sub

Sub getRGB( lRGB As Long ) As String
   lColors = lRGB \ 256
   lRed = lColors \ 256
   lGreen = lColors - lRed * 256
   lBlue = lRGB - 256 * lColors
   getRGB = lRed & ", " & lGreen & ", " & lBlue
End Sub