Excel to DXF dimension text and arrow enlargement

simonm

Can someone guide me on how to properly enlarge dimension text and arrowheads in a DXF file generated from VBA?

I’ve been working on a project in Excel to simplify some calculations, and I came up with the idea to generate a preliminary drawing via a DXF file instead of importing results into BricsCAD using coordinates.

I'm facing an issue with enlarging the dimension text and arrowheads in the DXF file. I've tried scaling the text, but it creates issues during later editing, so that's clearly the wrong method. I’ve used code 40 for regular text, and it works fine, but it doesn’t seem to apply to dimension text. I’m also worried that I may have broken something else in the process.

My code is functional in terms of drawing lines and adding dimensions (with rounding to 5 cm and handling negative values). However, I can't figure out how to change the size of the dimension text or the arrowheads. I also tried moving the dimension text vertically, but for some reason, I can only shift it sideways.

Has anyone else experienced this problem?

Sub DodajWymiarowanie(fileNumber As Integer)
    Dim lastRow As Long
    Dim i As Long
    Dim firstDataRow As Long
    Dim wymiar As String
    Dim odleglosc As Double
    Dim roznicaY As Double

    ' Znajdź pierwszy i ostatni wiersz z danymi w kolumnie B i C
    firstDataRow = 13 ' Ustalenie startu od wiersza 13
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row ' Ostatni wiersz z danymi w kolumnie B

    ' Dodanie wymiarowania liniowego w pliku DXF
    For i = firstDataRow To lastRow
        ' Sprawdzenie, czy są dane w kolumnach B, C oraz I, J, oraz pomijanie pierwszego i ostatniego wiersza
        If i <> firstDataRow And i <> lastRow Then
            If IsNumeric(Cells(i, 2).Value) And IsNumeric(Cells(i, 3).Value) And IsNumeric(Cells(i, 9).Value) And IsNumeric(Cells(i, 10).Value) Then
                ' Oblicz odległość między punktami
                odleglosc = Sqr((Cells(i, 9).Value - Cells(i, 2).Value) ^ 2 + (Cells(i, 10).Value - Cells(i, 3).Value) ^ 2)

                ' Obliczenie różnicy między wartościami Y z kolumny C i J
                roznicaY = Cells(i, 3).Value - Cells(i, 10).Value

                ' Zaokrąglenie odległości do najbliższych 5 cm i dodanie minusa lub plusa w zależności od różnicy
                If roznicaY < -0.024999 Then
                    wymiar = "-" & FormatZaokraglenieDo5cm(odleglosc) & "m" ' Dodanie minusa, jeśli różnica jest ujemna
                Else
                    wymiar = FormatZaokraglenieDo5cm(odleglosc) & "m" ' Standardowy wymiar, jeśli różnica jest dodatnia
                End If

                ' Dodaj wymiarowanie pomiędzy punktami
                Print #fileNumber, "0"
                Print #fileNumber, "DIMENSION"
                Print #fileNumber, "8"
                Print #fileNumber, "WYMIAROWANIE"
                
                ' Ustawienie koloru na niebieski (DXF color code 5)
                Print #fileNumber, "62"
                Print #fileNumber, "5" ' Kod koloru dla niebieskiego
                
                Print #fileNumber, "100"
                Print #fileNumber, "AcDbAlignedDimension"
                
                ' Środkowy punkt wymiarowania (gdzie pojawi się tekst wymiarowy)
                Print #fileNumber, "10" ' Punkt wymiarowy X
                Print #fileNumber, Replace(Format((Cells(i, 2).Value + Cells(i, 9).Value) / 2, "0.000"), ",", ".")
                Print #fileNumber, "20" ' Punkt wymiarowy Y
                Print #fileNumber, Replace(Format((Cells(i, 3).Value + Cells(i, 10).Value) / 2, "0.000"), ",", ".")
                Print #fileNumber, "30" ' Współrzędna Z
                Print #fileNumber, "0.0"
                
                ' Dodaj wartość wymiaru z powiększeniem
                Print #fileNumber, "1" ' Tekst wymiarowy
                Print #fileNumber, "\H11.1111111111x;" & wymiar ' Dodanie wymiaru po zaokrągleniu i powiększenia
                
                ' Punkty bazowe (Początkowy i końcowy punkt wymiarowania)
                Print #fileNumber, "13" ' Punkt początkowy X
                Print #fileNumber, Replace(Format(Cells(i, 2).Value, "0.000"), ",", ".")
                Print #fileNumber, "23" ' Punkt początkowy Y
                Print #fileNumber, Replace(Format(Cells(i, 3).Value, "0.000"), ",", ".")
                Print #fileNumber, "33"
                Print #fileNumber, "0.0" ' Z

                Print #fileNumber, "14" ' Punkt końcowy X
                Print #fileNumber, Replace(Format(Cells(i, 9).Value, "0.000"), ",", ".")
                Print #fileNumber, "24" ' Punkt końcowy Y
                Print #fileNumber, Replace(Format(Cells(i, 10).Value, "0.000"), ",", ".")
                Print #fileNumber, "34"
                Print #fileNumber, "0.0" ' Z
                
                ' Wartość wymiaru
                Print #fileNumber, "50" ' Kąt wymiarowania
                Print #fileNumber, "0.0"

                ' Wymiarowanie wyśrodkowane
                Print #fileNumber, "70" ' Flaga wymiarowania (aligned)
                Print #fileNumber, "1" ' Aligned dimension
                
                ' Zakończ wymiarowanie
                Print #fileNumber, "0"
                Print #fileNumber, "SEQEND"
            End If
        End If
    Next i
End Sub

Function FormatZaokraglenieDo5cm(wartosc As Double) As String
    ' Zaokrąglanie wartości do najbliższych 5 cm (0.05 metra)
    Dim zaokraglonaWartosc As Double
    zaokraglonaWartosc = Round(wartosc * 20, 0) / 20

    ' Sprawdzenie, czy liczba kończy się na .05 lub .15 (itd.) - wtedy pokazujemy dwa miejsca po przecinku
    If zaokraglonaWartosc * 100 Mod 10 = 5 Then
        FormatZaokraglenieDo5cm = Format(zaokraglonaWartosc, "0.00") ' Dwa miejsca po przecinku
    Else
        ' W przeciwnym wypadku pokazujemy jedno miejsce po przecinku
        FormatZaokraglenieDo5cm = Format(zaokraglonaWartosc, "0.0")
    End If
End Function

What I've already tried:

Print #fileNumber, "\H11.1111111111x;"` ' It works, but it's not the proper method for further text processing.

' Ustawienie wysokości tekstu dla każdego wymiaru
Print #fileNumber, "40"
Print #fileNumber, "4.0" ' Wysokość tekstu ustawiona na 4 jednostki` -  doesn't work

Const DEFAULT_FONT_SIZE As Double = 2.0

Print #fileNumber, "9"
Print #fileNumber, "$DIMTXT"
Print #fileNumber, "40"
Print #fileNumber, "2.0"

' Powiększenie strzałek (42) oraz tekstu wymiarowego (140)

                Print #fileNumber, "42" ' Wielkość strzałek

                Print #fileNumber, "2.5" ' Powiększ strzałki do 2.5 jednostek


                Print #fileNumber, "140" ' Wielkość tekstu wymiarowego

                Print #fileNumber, "3.0" ' Powiększ tekst do 3 jednostek

jbn1

I do not work with VBA, but described effects suggest problems with dimension styles and related with them system variables.

Virgil

Hello.

Something worth noting could be that a dimension is a combined entity, like a block.
The dimension entity contains some geometric entities - the lines and the arrow symbols - and a MTEXT entity, used to display the value and other texts.

In fact, the dimension text height is specific to the mtext sub-entity, and not to the dimension itself.
Given this, it seems very complicated to adjust the dimension text height while programmatically creating a dxf file from scratch.
This would require in-depth knowledge about the dxf codes and especially about the structure of a dxf file.

Maybe, an approach could be to create an empty drawing template with some custom settings.
This drawing could be saved as dxf and used as a header and a footer.

Then, the workflow could create a new dxf file, write the header, write the custom content - the dimensions, and write the footer.

This way, the dimension will use the exisitng custom settings - text style, dimensions style, ... - as set in the original template.

simonm

jbn1 partially guided me toward a solution to the problem, along with someone from another forum who confirmed that this piece of code looks fine. The changes had to be made elsewhere. I still have some chaos in my file, with dimensioning text being set in several places, but through trial and error, I managed to figure it out. Overall, I think it would be very difficult to edit a DXF file without completely overwriting it using VBA. I have a separate file where I normally draw what I decided to automate a bit, and now I want to paste this DXF into that file. I’ve managed to enlarge both the dimensioning text and arrows, which is a big success. However, as soon as I copy the entire drawing into the main file, both the dimensioning text and arrows shrink for some reason. This issue has happened to me before with DWG files, so I think it’s partly a BricsCAD bug. When we used AutoCAD, this never happened—AutoCAD never rescaled my objects when copying.

ALANH

Why not just draw in Bricscad no need for a dxf, open a blank dwg, you need to make subs for each entity.

I only dabbled with this. As I normally read a excel direct and make objects.

draw object xl bricscad.zip