VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

dimensions text enlargment excel vba to dxf

0 REPLIES 0
Reply
Message 1 of 1
szmDJ3PN
919 Views, 0 Replies

dimensions text enlargment excel vba to dxf

 

I want to change the text size and the arrow size in the dimension.

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




‐--------------------
I've tried this:


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"

 

 

 

0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report