Sub NestObjects()
    Dim s As Shape, sr As ShapeRange
    Dim areaWidth As Double, areaHeight As Double
    Dim xOffset As Double, yOffset As Double
    Dim currentX As Double, currentY As Double
    Dim maxHeightInRow As Double
    
    ActiveDocument.Unit = cdrMillimeter
    
    ' Define the area where you want to nest the objects
    areaWidth = 750 ' Width of the area
    areaHeight = 750 ' Height of the area
    
    Set sr = ActiveSelectionRange
    If sr.Count = 0 Then
        MsgBox "Please select objects to nest."
        Exit Sub
    End If
    
    ' Initialize the starting position and offsets
    currentX = 0
    currentY = 0
    maxHeightInRow = 0
    xOffset = 1 ' Fixed distance between objects horizontally
    yOffset = 1 ' Fixed distance between objects vertically
    
    For Each s In sr
        ' Check if the object fits in the current row, otherwise try rotating
        If (currentX + s.SizeWidth) > areaWidth Then
            s.Rotate 90
            If (currentX + s.SizeWidth) > areaWidth Then
                ' If it still doesn't fit, move to the next row
                s.Rotate -90 ' Rotate back to the original orientation
                currentX = 0
                currentY = currentY + maxHeightInRow + yOffset
                maxHeightInRow = 0
            End If
        End If
        
        ' Check if the object fits in the area, otherwise stop the macro
        If (currentY + s.SizeHeight) > areaHeight Then
            MsgBox "Not all objects could be nested within the specified area."
            Exit Sub
        End If
        
        ' Move the object to the current position
        s.SetPosition currentX, currentY
        
        ' Update the current position and the max height in the current row
        currentX = currentX + s.SizeWidth + xOffset
        If s.SizeHeight > maxHeightInRow Then
            maxHeightInRow = s.SizeHeight
        End If
    Next s
End Sub

Private Declare  Function GetAsyncKeyState Lib "user32" (ByVal vKey&) As Long 

PtrSafe

Private Sub btnExport_Click()
    ' Call the export function with user inputs
    ExportFiles txtFilePath.Text, chkDXF.Value, chkEPS.Value, chkPLT.Value
End Sub

Private Sub btnCancel_Click()
    ' Unload the form
    Unload Me
End Sub

Private Sub btnBrowse_Click()
    ' Call the function to browse for a folder
    txtFilePath.Text = BrowseForFolder("Select a folder for export")
End Sub

Function BrowseForFolder(Optional title As String = "Select a folder") As String
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = title
        If .Show = -1 Then ' If the user selects a folder
            BrowseForFolder = .SelectedItems(1)
        Else ' If the user cancels
            BrowseForFolder = ""
        End If
    End With
End Function

Sub ExportFiles(folderPath As String, exportDXF As Boolean, exportEPS As Boolean, exportPLT As Boolean)
    Dim doc As Document
    Set doc = ActiveDocument

    If folderPath = "" Then
        MsgBox "Please select a folder for export.", vbExclamation
        Exit Sub
    End If

    Dim fileName As String
    fileName = folderPath & "\" & doc.Name

    ' Ensure fileName is valid by removing invalid characters
    fileName = Replace(fileName, ":", "_")
    fileName = Replace(fileName, "\", "_")
    fileName = Replace(fileName, "/", "_")
    fileName = Replace(fileName, "*", "_")
    fileName = Replace(fileName, "?", "_")
    fileName = Replace(fileName, """", "_")
    fileName = Replace(fileName, "<", "_")
    fileName = Replace(fileName, ">", "_")
    fileName = Replace(fileName, "|", "_")

    On Error Resume Next

    If exportDXF Then
        Call ExportDXF(fileName & ".dxf")
    End If

    If exportEPS Then
        doc.Export fileName & ".eps", cdrEPS
        If Err.Number <> 0 Then
            MsgBox "Error exporting to EPS: " & Err.Description, vbExclamation
            Err.Clear
        End If
    End If

    If exportPLT Then
        doc.Export fileName & ".plt", cdrPLT
        If Err.Number <> 0 Then
            MsgBox "Error exporting to PLT: " & Err.Description, vbExclamation
            Err.Clear
        End If
    End If

    MsgBox "Export completed successfully!", vbInformation
End Sub

Sub ShowExportForm()
    ' Show the user form
    ExportForm.Show
End Sub

Sub ExportDXF(fileName As String)
    Dim OrigSelection As ShapeRange
    Set OrigSelection = ActiveSelectionRange
    OrigSelection.CreateSelection
    Dim expopt As StructExportOptions
    Set expopt = CreateStructExportOptions
    expopt.UseColorProfile = True
    Dim expflt As ExportFilter
    Set expflt = ActiveDocument.ExportEx(fileName, cdrDXF, cdrSelection, expopt)
    With expflt
        .BitmapType = 0 ' FilterDXFLib.dxfBitmapJPEG
        .TextAsCurves = True
        .Version = 6 ' FilterDXFLib.dxfVersion9
        .Units = 0 ' FilterDXFLib.dxfInches
        .FillUnmapped = True
        .FillColor = 0
        .Finish
    End With
End Sub

ActiveSelection.objectData("Name"). value = kh-01#

if not exist "%APPDATA%\Corel\CorelDRAW Graphics Suite X6\Draw\GMS\" mkdir "%APPDATA%\Corel\CorelDRAW Graphics Suite X6\Draw\GMS"
copy KHRECTANGLEv3.01.gms "%APPDATA%\Corel\CorelDRAW Graphics Suite X6\Draw\GMS"