There is, as far as I know, no way to show the grid on top of all objects.You can however change the color in the Objects docker, just as with any other layer.Click the (grey) colored bar on the right hand side of the Grid layer in the docker, and select any color from the dialog that appears.
This overlay is a good command hence asking in a future update. user can notice every element horizontally and vertically alignment with other objects at once. By having beneath the objects there is no use of this. hence this option is very useful
Maybe that's it, here I used lines on the screen, but I could use regular lines, the code needs improvements and be converted to VBA
OnScreenCurve sCurve; [CgsAddInMacro] public void CreateOverlapGrid(bool around = true, bool inCenter = true) { try { corelApp.Optimization = true; corelApp.EventsEnabled = false; corelApp.ActiveDocument.PreserveSelection = true; corelApp.ActiveDocument.BeginCommandGroup(); ShapeRange selection = corelApp.ActiveSelectionRange; Rect sRect = selection.BoundingBox; Layer vLayer = corelApp.ActiveVirtualLayer; ShapeRange linesH = corelApp.CreateShapeRange(); ShapeRange linesV = corelApp.CreateShapeRange(); for (int i = 1; i <= selection.Count; i++) { Rect rect = selection[i].BoundingBox; if (around) { linesH.Add(vLayer.CreateLineSegment(sRect.Left, rect.Top, sRect.Right, rect.Top)); linesH.Add(vLayer.CreateLineSegment(sRect.Left, rect.Bottom, sRect.Right, rect.Bottom)); linesV.Add(vLayer.CreateLineSegment(rect.Left, sRect.Top, rect.Left, sRect.Bottom)); linesV.Add(vLayer.CreateLineSegment(rect.Right, sRect.Top, rect.Right, sRect.Bottom)); } if (inCenter) { linesH.Add(vLayer.CreateLineSegment(sRect.Left, rect.CenterY, sRect.Right, rect.CenterY)); linesV.Add(vLayer.CreateLineSegment(rect.CenterX, sRect.Top, rect.CenterX, sRect.Bottom)); } } linesH.Sort("@shape1.com.positiony < @shape2.com.positiony"); linesV.Sort("@shape1.com.positionx < @shape2.com.positionx"); ShapeRange lines = corelApp.CreateShapeRange(); ShapeRange garbage = corelApp.CreateShapeRange(); double py = 0; while (linesH.Count > 0) { if (Math.Abs(linesH[1].PositionY - py) > 0.0001d) { lines.Add(linesH[1]); py = linesH[1].PositionY; } else { garbage.Add(linesH[1]); } linesH.Remove(1); } double px = 0; while (linesV.Count > 0) { if (Math.Abs(linesV[1].PositionX - px) > 0.0001d) { lines.Add(linesV[1]); px = linesV[1].PositionX; } else { garbage.Add(linesV[1]); } linesV.Remove(1); } Shape lShape = lines.Combine(); sCurve = corelApp.CreateOnScreenCurve(); sCurve.SetCurve(lShape.Curve); sCurve.Show(); lShape.Delete(); garbage.Delete(); } catch (Exception e) { MessageBox.Show(e.Message); } finally { corelApp.Optimization = false; corelApp.EventsEnabled = true; corelApp.ActiveDocument.PreserveSelection = false; corelApp.ActiveDocument.EndCommandGroup(); corelApp.Refresh(); Thread.Sleep(1000); MessageBox.Show("Waiting"); sCurve.Hide(); } }
how to use this code. please someone convert and provide here as .Gms.
converted by chatGPT
Sub CreateOverlabGridAround() CreateOverlapGrid True, FalseEnd SubSub CreateOverlapGrid(Optional ByVal around As Boolean = True, Optional ByVal inCenter As Boolean = True) On Error GoTo ErrorHandler ' Não é necessário criar explicitamente uma instância do CorelDRAW.Application Optimization = True EventsEnabled = False ActiveDocument.PreserveSelection = True ActiveDocument.BeginCommandGroup Dim selection As ShapeRange Set selection = ActiveSelectionRange Dim sRect As rect Set sRect = selection.BoundingBox Dim vLayer As Layer Set vLayer = ActiveVirtualLayer Dim linesH As ShapeRange Set linesH = CreateShapeRange Dim linesV As ShapeRange Set linesV = CreateShapeRange Dim i As Integer For i = 1 To selection.Count Dim rect As rect Set rect = selection(i).BoundingBox If around Then linesH.Add vLayer.CreateLineSegment(sRect.Left, rect.Top, sRect.Right, rect.Top) linesH.Add vLayer.CreateLineSegment(sRect.Left, rect.Bottom, sRect.Right, rect.Bottom) linesV.Add vLayer.CreateLineSegment(rect.Left, sRect.Top, rect.Left, sRect.Bottom) linesV.Add vLayer.CreateLineSegment(rect.Right, sRect.Top, rect.Right, sRect.Bottom) End If If inCenter Then linesH.Add vLayer.CreateLineSegment(sRect.Left, rect.CenterY, sRect.Right, rect.CenterY) linesV.Add vLayer.CreateLineSegment(rect.CenterX, sRect.Top, rect.CenterX, sRect.Bottom) End If Next i linesH.Sort "@shape1.com.positiony < @shape2.com.positiony" linesV.Sort "@shape1.com.positionx < @shape2.com.positionx" Dim lines As ShapeRange Set lines = CreateShapeRange Dim garbage As ShapeRange Set garbage = CreateShapeRange Dim py As Double py = 0 Do While linesH.Count > 0 If Abs(linesH(1).PositionY - py) > 0.0001 Then lines.Add linesH(1) py = linesH(1).PositionY Else garbage.Add linesH(1) End If linesH.Remove 1 Loop Dim px As Double px = 0 Do While linesV.Count > 0 If Abs(linesV(1).PositionX - px) > 0.0001 Then lines.Add linesV(1) px = linesV(1).PositionX Else garbage.Add linesV(1) End If linesV.Remove 1 Loop Dim lShape As Shape Set lShape = lines.Combine Dim sCurve As OnScreenCurve Set sCurve = CreateOnScreenCurve sCurve.SetCurve lShape.Curve sCurve.Show lShape.Delete garbage.Delete DoEvents
ErrorHandler: MsgBox Err.Description ' Finally block Optimization = False EventsEnabled = True ActiveDocument.PreserveSelection = False ActiveDocument.EndCommandGroup Refresh MsgBox "Waiting" sCurve.HideEnd Sub
it is creating. but there 2 dialog boxes coming.
1) first dialog box
2) 2nd dialog box
Later, the created overay line are removing.
Its fantastic. please someone edit the macro to stay the lines as regular lines. so that user can snap to that or move to that lines or delete them later.
Option Explicit
Const tempLayerName = "Grid lines"
Public lineColor As New Color
Sub DrawLineGrid() On Error GoTo ErrorHandler Dim selection As ShapeRange Set selection = ActiveSelectionRange Dim tempLayer As Layer Set tempLayer = selection.FirstShape.Page.CreateLayer(tempLayerName) Dim lines As ShapeRange Set lines = CreateShapeRange() Application.Optimization = True Application.EventsEnabled = False ActiveDocument.PreserveSelection = True ActiveDocument.BeginCommandGroup Dim i As Integer For i = 1 To selection.Count lines.Add tempLayer.CreateLineSegment(selection.LeftX, selection(i).TopY, selection.RightX, selection(i).TopY) lines.Add tempLayer.CreateLineSegment(selection.LeftX, selection(i).BottomY, selection.RightX, selection(i).BottomY) lines.Add tempLayer.CreateLineSegment(selection(i).LeftX, selection.TopY, selection(i).LeftX, selection.BottomY) lines.Add tempLayer.CreateLineSegment(selection(i).RightX, selection.TopY, selection(i).RightX, selection.BottomY) lines.Add tempLayer.CreateLineSegment(selection(i).CenterX, selection.TopY, selection(i).CenterX, selection.BottomY) lines.Add tempLayer.CreateLineSegment(selection.LeftX, selection(i).CenterY, selection.RightX, selection(i).CenterY) Next i lines.SetOutlineProperties Color:=lineColor tempLayer.Editable = False Application.Optimization = False Application.EventsEnabled = True ActiveDocument.PreserveSelection = False ActiveDocument.EndCommandGroup Application.Refresh Exit SubErrorHandler: MsgBox Err.DescriptionEnd Sub
Sub RemoveLineGrid() On Error Resume Next Dim l As Layer Dim item As Page For Each item In ActiveDocument.Pages Do Set l = item.Layers.Find(tempLayerName) If Not (l Is Nothing) Then l.Editable = True l.Delete End If Loop While Not (l Is Nothing) Next itemEnd Sub
Sub ChangeLineColor() On Error Resume Next lineColor.UserAssign Dim l As Layer Dim item As Page For Each item In ActiveDocument.Pages Set l = item.Layers.Find(tempLayerName) If Not (l Is Nothing) Then l.Editable = True l.Shapes.All.SetOutlineProperties Color:=lineColor l.Editable = False End If Next itemEnd Sub
Sub SetVisible() On Error Resume Next Dim l As Layer Dim item As Page For Each item In ActiveDocument.Pages Set l = item.Layers.Find(tempLayerName) If Not (l Is Nothing) Then l.Visible = Not l.Visible End If Next itemEnd Sub
you are amazing sir. So nice of you sir. Thanking you so much