Text or Mtext With DASHED Underline

Discussion in 'AutoCAD' started by Rick Spangenberger, Feb 10, 2005.

  1. I'm looking for a routine to underline text or mtext with a dashed line. It
    is used for adjacent parcel information on Certified Survey Maps. If the
    routine could draw a dashed line under the text at the current drawing
    scale, the width of the text, and a specified distance below the text, this
    would be great. Can this be done in Lisp? What do I have to do to get
    started?

    Thanks All
     
    Rick Spangenberger, Feb 10, 2005
    #1
  2. Rick Spangenberger

    Adesu Guest

    Try this,

    ; tu is stand for create text underline
    ; Design by Ade Suharna <>
    ; 11 February 2005
    ; Program no.186/02/2005
    ; Edit by
    (defun c:tu (/ ss ssn sse sp th gap tb tb1 tlen ep
    elast ename opt)
    (prompt "\nSELECT A TEXT")
    (setq ss (ssget '((0 . "TEXT")))
    ssn (ssname ss 0)
    sse (entget ssn)
    sp (cdr (assoc 10 sse))
    th (cdr (assoc 40 sse))
    gap (* th 0.2)
    tb (textbox sse)
    tb1 (nth 1 tb)
    tlen (car tb1)
    sp (list (car sp)(- (cadr sp) gap)(caddr sp))
    ep (list (+ (car sp) tlen)(cadr sp)(caddr sp)))
    (command "_line" sp ep "")
    (setq elast (entget (entlast))
    ename (cdr (car elast))
    opt (getstring "\nENTER NEW LINETYPE NAME: "))
    (command "_change" ename "" "p" "lt" opt "")
    (princ)
    )
     
    Adesu, Feb 11, 2005
    #2
  3. Adesu,

    This is very close to what I had in mind. I wanted the line to be created
    after the dtext is typed, automatically. Also need the linetype scale of
    the line to be adjustable (user input).

    Thanks for your hard work.
     
    Rick Spangenberger, Feb 11, 2005
    #3
  4. Rick Spangenberger

    Adesu Guest

    Here Rick for temporary,for edit scale of linetype ,I am still modifitioning

    ; ntu is stand for create new text underline
    ; Design by Ade Suharna <>
    ; 11 February 2005
    ; Program no.187/02/2005
    ; Edit by
    (defun c:ntu (/ tx hei loc ss ssn sse sp th gap tb tb1
    tlen ep elast ename opt)
    (setq tx (getstring T "\nENTER NEW TEXT TO ADD UNDERLINE: "))
    (setq hei (getreal "\nENTER NEW HEIGHT TEXT: "))
    (setq loc (getpoint "\nENTER LOCATION FOR OBJECT: "))
    (command "_text" loc hei "" tx "")
    (setq ss (entlast))
    (setq sse (entget ss))
    (setq sp (cdr (assoc 10 sse)))
    (setq th (cdr (assoc 40 sse)))
    (setq gap (* th 0.2))
    (setq tb (textbox sse))
    (setq tb1 (nth 1 tb))
    (setq tlen (car tb1))
    (setq sp (list (car sp)(- (cadr sp) gap)(caddr sp)))
    (setq ep (list (+ (car sp) tlen)(cadr sp)(caddr sp)))
    (command "_line" sp ep "")
    (setq elast (entget (entlast))
    ename (cdr (car elast))
    opt (getstring "\nENTER NEW LINETYPE NAME: "))
    (command "_change" ename "" "p" "lt" opt "")
    (princ)
    )
     
    Adesu, Feb 11, 2005
    #4
  5. Rick Spangenberger

    Adesu Guest

    Hi Rick.here the final code

    ; ntu is stand for create new text underline
    ; Design by Ade Suharna <>
    ; 11 February 2005
    ; Program no.187/02/2005
    ; Edit by
    (defun c:ntu (/ tx hei loc ss ssn sse sp th gap tb tb1
    tlen ep elast ename opt ss2 ent sf opt1)
    (vl-load-com)
    (setq tx (getstring T "\nENTER NEW TEXT TO ADD UNDERLINE: "))
    (setq hei (getreal "\nENTER NEW HEIGHT TEXT: "))
    (setq loc (getpoint "\nENTER LOCATION FOR OBJECT: "))
    (command "_text" loc hei "" tx "")
    (setq ss (entlast))
    (setq sse (entget ss))
    (setq sp (cdr (assoc 10 sse)))
    (setq th (cdr (assoc 40 sse)))
    (setq gap (* th 0.2))
    (setq tb (textbox sse))
    (setq tb1 (nth 1 tb))
    (setq tlen (car tb1))
    (setq sp (list (car sp)(- (cadr sp) gap)(caddr sp)))
    (setq ep (list (+ (car sp) tlen)(cadr sp)(caddr sp)))
    (command "_line" sp ep "")
    (setq elast (entget (entlast))
    ename (cdr (car elast))
    opt (getstring "\nENTER NEW LINETYPE NAME: "))
    (command "_change" ename "" "p" "lt" opt "")
    (setq ss2 (entlast))
    (setq ent (vlax-ename->vla-object ss2))
    (setq sf (rtos (vlax-get-property ent "LinetypeScale")))
    (setq opt1 (getreal (strcat "\nENTER NEW LINE TYPE SCALE" "<" sf ">" ":
    ")))
    (vla-put-LinetypeScale ent opt1)
    (princ)
    )
     
    Adesu, Feb 11, 2005
    #5
  6. Adesu,

    the Lisp routine returns this error:
    bad argument type: consp nil

    Otherwise it looks very good.

    Thans very much
     
    Rick Spangenberger, Feb 11, 2005
    #6
  7. Ade Suharna,

    Thanks for your invaluable input. I didn't realize that the routine uses
    the "Standard text style" to function.
     
    Rick Spangenberger, Feb 12, 2005
    #7
  8. Rick Spangenberger

    ECCAD Guest

    Rick,
    Here ya go..
    ;; ntu2.lsp
    ;; modified by Bob Shaw..from C:ntu by Ade Suharna
    ;; www.bobscadshop.com
    ;; :)
    ;;
    ;; Changes:
    ; I would like it to use the current text style and height, instead of the
    ; standard style and prompting me for a height.

    ; I would like it to use hidden as the linetype, instead of being prompted.

    ; I would like it to retain the initially prompted input value for the
    ; linetype scale, until I change it.

    ; Finally, stay in the command until I force an exit.

    ; ntu is stand for create new text underline
    ; Design by Ade Suharna <>
    ; 11 February 2005
    ; Program no.187/02/2005
    ; Edit by
    (defun c:ntu (/ tx hei loc ss ssn sse sp th gap tb tb1 tlen ep elast ename opt ss2 ent sf opt1)
    (vl-load-com)
    (setq txsty (getvar "textstyle")); current text style
    (if (not hei) (setq hei (getreal "\nENTER TEXT HEIGHT: ")))
    (while (/= tx ""); stay in loop
    (setq tx (getstring T "\nENTER NEW TEXT TO ADD UNDERLINE: "))
    (if (/= tx "")
    (progn
    (setq loc (getpoint "\nPICK LOCATION FOR TEXT: "))
    (command "_text" loc hei "" tx)
    (setq ss (entlast))
    (setq sse (entget ss))
    (setq sp (cdr (assoc 10 sse)))
    (setq th (cdr (assoc 40 sse)))
    (setq gap (* th 0.2))
    (setq tb (textbox sse))
    (setq tb1 (nth 1 tb))
    (setq tlen (car tb1))
    (setq sp (list (car sp)(- (cadr sp) gap)(caddr sp)))
    (setq ep (list (+ (car sp) tlen)(cadr sp)(caddr sp)))
    (command "_line" sp ep "")
    (setq elast (entget (entlast)))
    (setq ename (cdr (car elast)))
    (setq opt "HIDDEN"); force Hidden Line Type
    (command "_change" ename "" "p" "lt" opt "")
    (setq ss2 (entlast))
    (setq ent (vlax-ename->vla-object ss2))
    (setq sf (rtos (vlax-get-property ent "LinetypeScale")))
    (setq opt1 (getreal (strcat "\nENTER NEW LINE TYPE SCALE" "<" sf ">" ": ")))
    (if (not opt1) (setq opt1 (atof sf)))
    (vla-put-LinetypeScale ent opt1)
    );progn
    );if
    );while
    (princ)
    );function

    Bob
     
    ECCAD, Feb 12, 2005
    #8
  9. Rick Spangenberger

    ECCAD Guest

    Rick,
    This one doesn't ask for Text Height.

    ;; ntu3.lsp
    ;; modified by Bob Shaw..from C:ntu by Ade Suharna
    ;; www.bobscadshop.com
    ;; :)
    ;;
    ;; Changes:
    ; I would like it to use the current text style and height, instead of the
    ; standard style and prompting me for a height.

    ; I would like it to use hidden as the linetype, instead of being prompted.

    ; I would like it to retain the initially prompted input value for the
    ; linetype scale, until I change it.

    ; Finally, stay in the command until I force an exit.

    ; ntu is stand for create new text underline
    ; Design by Ade Suharna <>
    ; 11 February 2005
    ; Program no.187/02/2005
    ; Edit by
    (defun c:ntu (/ tx hei loc ss ssn sse sp th gap tb tb1 tlen ep elast ename opt ss2 ent sf opt1)
    (vl-load-com)
    (while (/= tx ""); stay in loop
    (setq tx (getstring T "\nENTER NEW TEXT TO ADD UNDERLINE: "))
    (if (/= tx "")
    (progn
    (setq loc (getpoint "\nPICK LOCATION FOR TEXT: "))
    (command "_text" loc "" "" tx)
    (setq ss (entlast))
    (setq sse (entget ss))
    (setq sp (cdr (assoc 10 sse)))
    (setq th (cdr (assoc 40 sse)))
    (setq gap (* th 0.2))
    (setq tb (textbox sse))
    (setq tb1 (nth 1 tb))
    (setq tlen (car tb1))
    (setq sp (list (car sp)(- (cadr sp) gap)(caddr sp)))
    (setq ep (list (+ (car sp) tlen)(cadr sp)(caddr sp)))
    (command "_line" sp ep "")
    (setq elast (entget (entlast)))
    (setq ename (cdr (car elast)))
    (setq opt "HIDDEN"); force Hidden Line Type
    (command "_change" ename "" "p" "lt" opt "")
    (setq ss2 (entlast))
    (setq ent (vlax-ename->vla-object ss2))
    (setq sf (rtos (vlax-get-property ent "LinetypeScale")))
    (setq opt1 (getreal (strcat "\nENTER NEW LINE TYPE SCALE" "<" sf ">" ": ")))
    (if (not opt1) (setq opt1 (atof sf)))
    (vla-put-LinetypeScale ent opt1)
    );progn
    );if
    );while
    (princ)
    );function

    Bob
     
    ECCAD, Feb 12, 2005
    #9
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.