Author Topic: Change dimension text and more  (Read 284 times)

Gymbo

  • Jr. Member
  • **
  • Posts: 77
Change dimension text and more
« on: April 29, 2018, 03:02:01 PM »
In an attempt to learn BasicCAD, after years of using VB6 I wrote a couple of macros. The first one TS.D3M is a simple little macro that shows you the current dimension text size and asks if you want to continue and change it, uses an Input statement to put in the new size then jumps to the more complex macro F.D3M using the Chain statement.

F.D3M measures the size of the drawing; calculates a text size based on those measurements *; decides whether to print landscape or portrait; gets the full path and file name and parses off the redundant section of the path, replacing it with '...\', then puts it in the upper left hand section of the drawing using a text size 2/3 the size of the normal text *; adds a number to the file name and increments it, if used more than once.

Any suggestions to improve these or the technique would be appreciated.

* unless TS.D3M called this macro

Code: [Select]
'TS.D3M Gymbo 4/29/18
'change all dim text & arrow size

precision 3
sys(1027) = 4
ts = sys(438)

message "Current size is: ", ts, ",  Continue?"
if sys(1028) = 7 then end

input "New text size", ts

ts$ = "ts"

chain "f.d3m"


Code: [Select]
'F.D3M Gymbo 4/29/18
'add file name and date to dwg,
'update dwg "index"
'chg text size based on dwg size

INCLUDE "dcadalias.d3i"
'sys(800) = 1
'break->
if ts$ <> "ts" then ts = 0
sys(1027) = 4
message "Change the text, too?"
YesNo = sys(1028)
true = 0 'if ts NOT from other macro
if ts <> 0 then true = 1 'already assigned
ent = sys(9)
x = sys(120)    'min x value
X1 = sys(122)   'max x value
Y2 = sys(123)   'max y
Y1 = sys(121)   'min y

X2 = X1 - x     'total length of drawing
y3 = Y2 - Y1    'total ht of dwg

y = Y2 * 1.02   'y spot for name

If X2 >= y3 Then
    vs = X2
    GoSub Land
Else
    vs = Y3
    GoSub Port
End If

ns = vs * 0.01  'size of text for name
if true = 0 then ts = vs * 0.015 'new text size
'gosub windowIt 'view var. values

If YesNo = 6 Then GoSub ChgTxt 'yes
GoSub ParseIt 'remove path from file name

For i = 1 To sys(9)
    GetAttr , i, t
    If t = 13 or t = 3 Then  'text
        entity i
        txt$ = sys$(1)
        GoSub GetIt 'is it file name?
        If GotIt = 1 Then 'yes
            GotIt = 0
            Exit For
        End If
    End If
Next

>Text2d 'place name/date
{
    <size [ns]
    <text [fullname$, sys$(8)]
    <pointxyz [x, y, 0]
}
if true = 1 then
goto jumpmsg
endif

message "Change Dimension text?"
If sys(1028) = 7 Then GoTo here 'no
jumpmsg:
GoSub Layers 'open all layers

GoSub ChgD_T 'chg dim text size

here: 'leave macro
>save
{
}
>fittowindow
{
}

End

ParseIt: 'remove path from file name
'increment file number
'add prefix (...\) to file name
precision 0
retry:
fn$ = sys$(2) 'full path name
leng = Len(fn$)
if leng = 0 then 'test for if saved
path$ = _
"D:\DesignCAD\IMSIDesign\DesignCAD 23\Drawings\"
input "Please enter a file name.", fn$
fnm$ = path$ + fn$
>SaveAs
{
<Filename [fnm$]
}
goto retry
endif
fname$ = Left$(fn$, leng - 4) 'remove ".dcd"
lstdig$ = Right$(fname$, 1)
n = Asc(lstdig$)
'add/increase number to/of file name
If n > 47 And n < 58 Then 'increment it
    n$ = Chr$(n)
    n1 = Val(n$) + 1
    Add$ = Int(n1)
    fname$ = Left$(fn$, leng - 5) + Add$
Else
    fname$ = fname$ + "1" 'add it
End If

fname$ = fname$ + ".DCD" 'add it back
>SaveAs
{
    <Filename [fname$]
}
f$ = sys$(2) 'new full path name
leng = Len(f$)
'parse it
Name$ = Right$(f$, 46, leng - 46)   'was 45
aa$ = "...\"
fullname$ = aa$ + Name$ + ",  "
'D:\DesignCAD\IMSIDesign\DesignCAD 23\Drawings\
Return

ChgTxt: 'chg text size based on dwg size
sys(12) = ts
For j = 1 To ent
    entity j
    Query ENT_TYPE, type
    if type = 13  or type = 3 then 
        Change T_SIZE, ts
        Update
    End If
Next
Return

Layers: 'make all layers visible & editable
Dim la(1000)
For i = 0 To 1000
    la(i) = layer(i)
    layer(i) = 6
Next
sys(1027) = 0
message "All layers are now visible!"
Return

WindowIt: 'debug tool
window 12, 30
Print " x =", x
Print " x1 =", X1
Print " x2 =", X2
Print " y =", y
Print " y1 =", Y1
Print " y2 =", Y2
Print " y3 =", y3
Print " ns =", ns
Print " ts =", ts
anykey
Return

ChgD_T: 'chg dim text size based on drawing size
For i = 1 To ent
    entity i
    Query Ent_type, type
    if type >73 and type < 82 then 'is it dim?
        Change D_TEXTSIZE, ts
        Change D_ARROWSIZE, ts * 0.8
update
    End If
    sys(438) = ts 'chg dim text size

Next
Return

Land: 'set printer for lanscape
    >paperSpaceMode
    {
    }
    >ChangePSTemplateProperties
    {
        <orientation 1
        <LeftMargin .5
        <rightmargin .5
        <topmargin .5
        <bottommargin .5
        <Name "LandscapeMode"
    }
    >paperSpaceMode
    {
    }
Return

Port: 'set printer for portrait
    >paperSpaceMode
    {
    }
    >ChangePSTemplateProperties
    {
        <orientation 0
        <LeftMargin .5
        <rightmargin .5
        <topmargin .5
        <bottommargin .5
        <Name "PortraitMode"
    }
    >paperSpaceMode
    {
    }
Return

GetIt: 'is it file name
test$ = "."
dot2$ = ".."
dot3$ = "..."
'check prefix for ...
If Left$(txt$, 1) <> test$ Then Return
    For j = 1 To 3
        If Mid$(txt$, 1, j) = test$ Then
            test$ = dot2$
            dot2$ = dot3$
            Next
        End If
   
    If j = 4 Then 'yes, now delete it
        putattr i, t, 1
        If t = 13 or t = 3 Then
            if sys(80) > 0 then
                >erase
                {
                }
                Update
            endif
        End If
        GotIt = 1
y = y2 * 0.99 'new y, y2 includes name/date
    End If
Return


Edit: 5/3/18, added SaveAs if not saved
« Last Edit: May 03, 2018, 08:22:24 AM by Gymbo »
Regards,

Jim