Author Topic: Text question  (Read 3864 times)

0 Members and 1 Guest are viewing this topic.

Matersammichman

  • Guest
Text question
« on: August 04, 2006, 01:21:21 PM »
How can you use vba to make underlined text?

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Text question
« Reply #1 on: August 04, 2006, 02:06:11 PM »
Like so:
Code: [Select]
Dim InsPt(2) As Double
Dim strTxt As String

strTxt = "How about %%uunderline%%u?"
ThisDrawing.ModelSpace.AddText strTxt, InsPt, 0.2

Matersammichman

  • Guest
Re: Text question
« Reply #2 on: August 04, 2006, 03:15:29 PM »
Hmmm...
I'm with ya, but I'd like to be able to put in the text from a text box input , and not have to put in "%%U" every time...
more ideas?

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Text question
« Reply #3 on: August 04, 2006, 03:36:31 PM »
Huh? You mean like this?
Code: [Select]
Dim InsPt(2) As Double
Dim strTxt As String

strTxt = "%%u" & TextBox1.Value & "%%u"
ThisDrawing.ModelSpace.AddText strTxt, InsPt, 0.2

Matersammichman

  • Guest
Re: Text question
« Reply #4 on: August 04, 2006, 03:52:20 PM »
Yes, thank you.

Matersammichman

  • Guest
Re: Text question
« Reply #5 on: October 31, 2006, 03:43:45 PM »
Okay, let's carry it a step further-
How would you create DOUBLE underlined text?

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
Re: Text question
« Reply #6 on: October 31, 2006, 03:44:49 PM »
Okay, let's carry it a step further-
How would you create DOUBLE underlined text?
how would you do it in regular acad?
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

Matersammichman

  • Guest
Re: Text question
« Reply #7 on: October 31, 2006, 03:46:50 PM »
unfortunately...draw another line under the text manually.

Greg B

  • Seagull
  • Posts: 12417
  • Tell me a Joke!
Re: Text question
« Reply #8 on: October 31, 2006, 03:54:34 PM »
I thought there was a font properties that allowed you to have double underline.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Text question
« Reply #9 on: October 31, 2006, 04:25:15 PM »
I thought there was a font properties that allowed you to have double underline.

not in AutoCAD
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

David Hall

  • Automatic Duh Generator
  • King Gator
  • Posts: 4075
Re: Text question
« Reply #10 on: October 31, 2006, 04:41:35 PM »
unfortunately...draw another line under the text manually.
given that, you could use the text ins pt, and calc the text length, then offset (or draw) a second line below the first.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second.
Sometimes the question is more important than the answer. (Thanks Kerry for reminding me)

Murphy

  • Guest
Re: Text question
« Reply #11 on: November 01, 2006, 05:00:39 AM »
I actually have this done in VBA as our titles at work are text with double underlines drawn in.
I will post the code once I get to work.

Murphy

  • Guest
Re: Text question
« Reply #12 on: November 01, 2006, 06:34:11 AM »
Obviously you can go and customize to your hearts content.
They are plines so that the width can be made to what you need.

Code: [Select]
Public Sub TitleLine()
 Dim objPick As AcadEntity
 Dim varPnt As Variant
 Dim strPrmt As String
 Dim objUtil As AcadUtility
 Dim fPt As Variant
 Dim rpt As Variant
 Dim txtIns As Variant
 Dim lin As AcadLine
 Dim plin As AcadPolyline
 Dim plinpts(0 To 5) As Double
 Dim linst(0 To 2) As Double
 Dim linend(0 To 2) As Double
 Dim fx As Variant
 Dim rx As Variant
 Dim midx As Variant
 Dim modscl As Integer
On Error GoTo ErrHandler
 strPrmt = vbCr & "Pick Title: "
 Set objUtil = ThisDrawing.Utility
DoOver:
 objUtil.GetEntity objPick, varPnt, strPrmt
 If TypeOf objPick Is AcadText Then
    objPick.GetBoundingBox fPt, rpt
    txtIns = objPick.InsertionPoint
    If rpt(0) - fPt(0) < 1.75 Then
        midx = fPt(0) + (0.5 * (rpt(0) - fPt(0)))
        fx = midx - 0.875
        rx = midx + 0.875
    Else
        fx = fPt(0)
        rx = rpt(0)
    End If
    If ThisDrawing.ActiveSpace = acPaperSpace Then
        plinpts(0) = fx
        plinpts(1) = txtIns(1) - 0.0625
        plinpts(2) = 0
        plinpts(3) = rx
        plinpts(4) = txtIns(1) - 0.0625
        plinpts(5) = 0
        Set plin = ThisDrawing.PaperSpace.AddPolyline(plinpts)
        plin.ConstantWidth = 0.03125
        plin.layer = "0"
        plin.color = acGreen
        linst(0) = fx
        linst(1) = plinpts(1) - 0.0625
        linst(2) = 0
        linend(0) = rx
        linend(1) = linst(1)
        linend(2) = 0
        Set lin = ThisDrawing.PaperSpace.AddLine(linst, linend)
        lin.layer = "0"
        lin.color = acGreen
    Else
        modscl = objPick.height / 0.175
        plinpts(0) = fx
        plinpts(1) = txtIns(1) - (0.0625 * modscl)
        plinpts(2) = 0
        plinpts(3) = rx
        plinpts(4) = txtIns(1) - (0.0625 * modscl)
        plinpts(5) = 0
        Set plin = ThisDrawing.ModelSpace.AddPolyline(plinpts)
        plin.ConstantWidth = (0.03125 * modscl)
        plin.layer = "0"
        plin.color = acGreen
        linst(0) = fx
        linst(1) = plinpts(1) - (0.0625 * modscl)
        linst(2) = 0
        linend(0) = rx
        linend(1) = linst(1)
        linend(2) = 0
        Set lin = ThisDrawing.ModelSpace.AddLine(linst, linend)
        lin.layer = "0"
        lin.color = acGreen
    End If
 End If
 'GoTo DoOver
ExitNow:
 Exit Sub
ErrHandler:
 Select Case Err.Number
    Case -2147352567
        Err.Clear
        GoTo ExitNow
    Case Else
        Err.Clear
        GoTo ExitNow
End Select
End Sub

Matersammichman

  • Guest
Re: Text question
« Reply #13 on: November 03, 2006, 07:57:46 AM »
Great code Murphy!
Thanks!

Murphy

  • Guest
Re: Text question
« Reply #14 on: November 06, 2006, 05:11:26 AM »
Not a problem. That's what makes this place so great.
Why redo what someone has already done?