Topic: Putting text onto screen not command line?

[Rob-GB]

Okay people, in my last post I stated that I was thinking of adding text to my stair lisp with information about the drawn stair. However, after some research(here and the ACAD help files) I have not found an answer/example to work from. With Cadtutor being revamped due to sicko hacker attacks that resource is, sadly, unavailable. Can anyone point me in the right direction, please.
What I hope to accomplish is a list of the stair vital statistics/cut list in a 'text box' next to the elevation in model space. Thanks.
Rob.

[Tharwat]

Hope that I got you well , and this is what come up to my mind right now. 

Code: [Select]

(defun c:test (/ mirr land n ip i p1 p2)
  ; Tharwat 11. 03. 2011
  (if (and (setq mirr (getdist "\n Mirror height of step :"))
           (setq land (getdist "\n Landing length of step :"))
           (setq n (getint "\n Number of steps :"))
           (setq ip (getpoint "\n Specify start point of steps :"))
           (setq i 1))
  (repeat n
    (setq p1 (polar ip (/ pi 2.) mirr)
          p2 (polar p1 0. land))
    (entmakex (list (cons 0 "LINE")(cons 10 ip)(cons 11 p1)))
    (entmakex (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)))
    (entmakex (list (cons 0 "TEXT")(cons 40 (/ mirr 4.))(cons 10 p1)(cons 1 (strcat "Step" (itoa i)))))
    (setq ip p2 i (1+ i))
    )
    (princ)
    )
    (princ)
  )

Regards,

Tharwat

[hmspe]

Do you mean enter text near an entity or just display values?

For entering text I'd look at using an OpenDCL modeless form.  If you want to do this without a form look try the code at http://www.theswamp.org/index.php?topic=25412.0

[BlackBox]

Assuming your previous code allows for you to store your 'vital statistics' during calculations, have you looked into vla-Add with MText?

[CAB]

Excerpts from my Stair Routine.

Code: [Select]

  (initget 9)
  (setq pt1 (getpoint "\nPick the point for the Top Step: "))
  (setq th (-(cadr pt1)(cadr ff)))
  (setq txtpt (polar pt1 (* pi 0.5) 80)) ; location for text
 
 
 
  ;;=========================
  ;; print information in the drawing
  ;;=========================
  (initget "Yes No") ; true = Yes
  (setq prntxt (getkword  "\nAdd Stair Dimensions Text To Drawing? (Y or N) <Y>"))
  (if (not (and prntxt  (= prntxt "No")))
    (progn
      (if (zerop (setq txtht (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))))
       (setq txtht (getvar "TEXTSIZE"))
      )
      (TextAdd (strcat "Overall Height Is: " (rtos th 4 4)) txtpt txtht nil)
      (setq txtpt (polar txtpt (* 1.5 pi) (* txtht 1.7125)))
      (TextAdd (strcat (itoa nor)" Risers @ "(rtos rht 5 5)"\"") txtpt txtht nil)
      (setq txtpt (polar txtpt (* 1.5 pi) (* txtht 1.7125)))
      (TextAdd (strcat (itoa (- nor 1))" Treads @ "(rtos tsiz 5 4)"\"") txtpt txtht nil)
      (setq txtpt (polar txtpt (* 1.5 pi) (* txtht 1.7125)))
      (TextAdd (strcat "Angle is: " (angtos (atan rht tsiz) 0 2)" Degrees") txtpt txtht nil)
      (setq txtpt (polar txtpt (* 1.5 pi) (* txtht 1.7125)))
    )
  )
 
  ;;=====================
  ;;  Add text to drawing
  ;;=====================
  (defun TextAdd (txt pt ht lay)
      (entmakex
        (list (cons 0 "TEXT")
               (cons 1 txt) ;* (the string itself)
               (cons 6 "BYLAYER") ; Linetype name
               (cons 8 (if lay lay (getvar "CLAYER")))   ; layer
               (cons 10 pt) ;* First alignment point (in OCS)
               (cons 11 pt) ;* Second alignment point (in OCS)
               (cons 40 ht) ;* Text height
               (cons 50 0.0) ; Text rotation ange
               (cons 71 0) ; Text generation flags
               (cons 72 0) ; Horizontal text justification type
               (cons 73 0) ; Vertical text justification type
               (cons 210 (list 0.0 0.0 1.0)))))

[Rob-GB]

Thanks guys plenty here for me to go through, just a quick question though... can you use VLA coding in plain non dcl lisp?

Rob.

[CAB]

Ah, yes. DCL has nothing to do with vla.
Maybe I miss understood your question.

[Rob-GB]

Okay I'm back... no don't run away...please.
Having trouble still. I have added to my stair lisp the following code but whatever I try it will only place the first line of text into the drawing.
I try to only use code that I understand the 'how' of, which means many trips through the help files (whose files never seem to answer my questions  :pissed: maybe I ask the wrong ones  :ugly:)
On the positive side I did get the first line in! 
Any assistance appreciated.
Rob.

Code: [Select]

(setq TORI (* STEPS RISE))
  (setq TOGO (* STEPS GOING))
      (setq TRDT (+ NOSING GOING))
   
 
  ;=========================================================================================;
  (defun TextAdd (txt TXPP ht lay)
      (entmakex
        (list (cons 0 "TEXT")
              (cons 1 txt) ;* (the string itself)
              (cons 6 "BYLAYER") ; Linetype name
              (cons 8 (if lay lay (getvar "CLAYER")))   ; layer
              (cons 10 TXPP) ;* First alignment point (in OCS)
              (cons 11 TXPP) ;* Second alignment point (in OCS) ;;not sure I totally understand this alignment point
              (cons 40 10.0) ;* Text height;; changed to set the text height I want to use
              (cons 50 0.0) ; Text rotation angle
              (cons 71 0) ; Text generation flags
              (cons 72 0) ; Horizontal text justification type
              (cons 73 0) ; Vertical text justification type
      (cons 210 (list 0.0 0.0 1.0))))) ;Code Courtesy of CAB
 

  ;=========================================================================================;
     
  (setq TXPP (getpoint "\nPick the point for the Text: "))
               (TextAdd (strcat "Total Rise Is:" (rtos TORI 2 2) "  Total Going Is:" (rtos TOGO 2 2)) TXPP TXTHT nil)
      (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
      (TextAdd (strcat " Risers Are: " (rtos RWTW 2 2)" By " (rtos RITH 2 2)" By "(rtos RIHT 2 2)) TXPP TXTHT nil)
        (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
         (TextAdd (strcat " Treads Are: "(rtos RWTW)" By "(rtos TRTH)" By "(rtos TRDT)) TXPP TXTHT nil)
          (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
           (TextAdd (strcat "Pitch Of Stair: " (angtos (atan RISE GOING) 0 2)" Degrees") TXPP TXTHT nil)
            (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))

[Tharwat]

Hello Rob.

Can you please post the complete routine with the new changes that you added ?

As I can see, you are trying to make a summary of the implemented routine . Am I right ?

One catch at the moment .

Code: [Select]

(defun TextAdd (txt TXPP [color=red]ht[/color] lay)
(cons 40 [color=red]ht[/color])

Hope that I can give a hand with your current construction with the routine .

Regards,

TharwaT

[Rob-GB]

Thanks Tharwat complete code below.

Code: [Select]

;=========================================================================================;
(defun C:stair3 (/ IP GOING RISE NOSING TRTH RITH STRTH WIDE STEPS a AA B C D E F G H K S N P
Q R R1 R2 R3 R4 R5 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 S1 S2 S3 S4 S5 S6 S7 S8 S9
PT1 PT2 PL1 PL2 PL3 PL4 PL5 PL6 PL7 PL8 PL9 PL10 N1 N2 N3 N4 N5 N6 N7 N8 N9 N10
RWTW TRENCH LEN ANG TXPP TXTPT TXTHT TOGO TORI TRDT prntxt OLDSNAP OLDBLIP OLDLIGHT OLDLAY)
;=========================================================================================;
; lisp routine to draw basic timber staircase, side elevation and plan view
; by Rob-GB 27.01.2011
; Acknowledgements are due to the many members of Cadtutor and The Swamp who give freely of their time and knowledge.
; Thanks
(setq OLDSNAP (getvar "OSMODE")
)
(setq OLDBLIP (getvar "BLIPMODE") ;store settings
)
(setq OLDLIGHT (getvar "HIGHLIGHT")
)
(setq OLDLAY (getvar "CLAYER")
)
(setvar "CMDECHO" 0)
        (setvar "BLIPMODE" 0)
;=========================================================================================;
;Basic dims required
;=========================================================================================;
(or GOING (setq GOING 230.0)) ;set default dims and allow user input
(or RISE (setq RISE 200.0))
  (or TRTH (setq TRTH 25.0))
   (or RITH (setq RITH 9.0))
    (or WIDE (setq WIDE 900.0))
     (or STRTH (setq STRTH 33.0))
              (or NOSING (setq NOSING 25.0))
         (or STEPS (setq STEPS 13.0))
        (setq AA (rtos GOING 2 1))
(setq B (rtos RISE  2 1))
  (setq C (rtos TRTH  2 1))
           (setq D (rtos RITH  2 1))
    (setq E (rtos WIDE  2 1))
     (setq F (rtos STRTH 2 1))
              (setq G (rtos NOSING 2 1))
                 (setq H (rtos STEPS 2 1))
 
(setq GOING (cond ((getdist (strcat "\nEnter going of tread <"AA">:")))     (T (setq GOING GOING))))
(setq RISE  (cond ((getdist (strcat "\nEnter rise of step <"B">:")))       (T (setq RISE RISE))))
(setq TRTH  (cond ((getdist (strcat "\nEnter tread thickness <"C">:")))    (T (setq TRTH TRTH))))
(setq RITH  (cond ((getdist (strcat "\nEnter riser thickness <"D">:")))    (T (setq RITH RITH))))
(setq WIDE  (cond ((getdist (strcat "\nEnter width across strings <"E">:")))      (T (setq WIDE WIDE)))) 
(setq STRTH (cond ((getdist (strcat"\nEnter string thickness <"F">:")))   (T (setq STRTH STRTH))))
(setq NOSING (cond ((getdist (strcat"\nEnter nosing projection <"G">:")))   (T (setq NOSING NOSING))))
(setq STEPS (getint "\nEnter number of risers : "))

(setq IP (getpoint "\nInsertion Point: ")
) ; bottom left finish floor level of first riser, stair will be drawn rising from left to right
;===============================================================================================================;
(defun DTR (a) (* PI (/ a 180.0)) ;degrees to radians
)
;===============================================================================================================;
;;; Layer Function - Set Layer & Linetype.                          ;Function Description
(defun SLL (NLAY CLR LT / LAY FRZ)                                  ;Define function, Declare local variables and arguments
  (setq LAY  (tblsearch "layer" NLAY))                              ;Search drawing to find layer, Note: (NOT USED)
   (if                                                              ;If the following returns true
    (not LAY)                                                       ;Layer not in drawing
     (command "_.layer" "m" NLAY "c" CLR "" "lt" LT "" "")          ;Layer command ~ make new layer with color and linetype
      (progn                                                        ;Then do the following
       (setq FRZ (cdr (assoc 70 LAY)))                              ;Variable FRZ is frozen layer
        (if (= FRZ 65)                                              ;Layer frozen from last edit
         (progn                                                     ;Then do the following
          (command "_.layer" "t" NLAY "")                           ;Thaw new layer if frozen
           (command "_.layer" "s" NLAY ""))                         ;Set new layer
            (command "_.layer" "s" NLAY ""))))                      ;Set new layer
)                                                                   ;End define function 
;=========================================================================================;
(setvar "OSMODE" 0) 
(setq P (* RISE RISE)
 )
  (setq Q (* GOING GOING)
   )
    (setq LEN (SQRT (+ P Q))
     )
      (setq PT1 (POLAR IP (DTR 90.0) RISE)
       )
        (setq PT2 (POLAR PT1 (DTR 0.0) GOING)
)
     
(setq S1 (POLAR IP (DTR 0.0) 100)
 )
  (setq S2 (POLAR IP (DTR 180.0) 150)
   )
    (setq S3 (POLAR S2 (DTR 90.0) 150)
     )
      (setq S4 (POLAR S3 (angle IP PT2) (* STEPS LEN))
       )
        (setq S5 (POLAR S4 (DTR 0.0) 250)
         )
          (setq S6 (POLAR S5 (DTR 270.0) 150)
           )
          (setvar "OSMODE" 0)
         (SLL "String" "63" "CONTINUOUS")      ;Go to SLL Layer Function, Set Layer, Color & Linetype
        (command "_.PLINE" S1 S2 S3 S4 S5 S6 S1 ""
       )
       ; string drawn
;============================================================================================================;
 ;Draw plan view of stair strings
(setq PL1 (POLAR IP (DTR 270.0) 150)
 )
  (setq PL2 (POLAR PL1 (DTR 180.0) 150)
   )
    (setq PL3 (POLAR PL2 (DTR 270.0) STRTH)
     )
      (setq PL4 (POLAR PL3 (DTR 0.0) 150)
       )
        (setq PL5 (POLAR PL4 (DTR 0.0) (+ (* STEPS GOING) 100))
         )
          (setq PL6 (POLAR PL5 (DTR 90.0) STRTH)
           )
      (setq PL7 (POLAR PL2 (DTR 270.0) WIDE)
       )
        (setq PL8 (POLAR PL6 (DTR 270.0) WIDE)
               )
                (setq PL9 (POLAR PL8 (DTR 90.0) STRTH)
                 )
                  (setq PL10 (POLAR PL7 (DTR 90.0) STRTH)
                   ) ;plan view string outlined
;============================================================================================================;
                  (setvar "OSMODE" 0)
(SLL "String" "63" "CONTINUOUS")     ;Go to SLL Layer Function, Set Layer, Color & Linetype
       (command "_.PLINE" PL1 PL2 PL3 PL4 PL5 PL6 PL1 ""
      )
             (command "_.PLINE" PL7 PL8 PL9 PL10 PL7 ""
    )       ; string drawn
;============================================================================================================;
(repeat STEPS
 (setq TRENCH 12)
  (setq RWTW (- WIDE (* STRTH 2))
   )
(setq N1 (POLAR PL4 (DTR 90.0) TRENCH) ;THIS COULD BE CHANGED TO HOUSING DEPTH WITH NEW QUESTION AT START
 )
  (setq N2 (POLAR N1 (DTR 270.0) (+ RWTW (* TRENCH 2)))
   )
    (setq N3 (POLAR N1 (DTR 180.0) NOSING)
     )
      (setq N4 (POLAR N3 (DTR 270.0) (+ RWTW (* TRENCH 2)))
       )
        (setq N5 (POLAR N4 (DTR 0.0) GOING)
         )     
          (setq N6 (POLAR N1 (DTR 0.0) GOING)
           )       
;============================================================================================================;
;set other dims
(setq GR 10) ;sets depth of groove in tread to accept riser
  (setq GRD (- TRTH GR)) ;gives tread thickness less riser groove depth
 
;=========================================================================================;
; plot points for side elevation
(setq R1 (POLAR IP (DTR 90.0) (- RISE GRD)) ; riser side elevation from insert point
 )
  (setq R2 (POLAR R1 (DTR 0.0) RITH)
   )
    (setq R3 (POLAR R2 (DTR 270.0) (- RISE GRD))
     )
      (setq R4 (POLAR R3 (DTR 270.0) TRTH)
       )
        (setq R5 (POLAR R4 (DTR 180.0) RITH)
         )
;====================================================================================;
;treads
(setq T1 (POLAR R1 (DTR 270.0) GR) ; top corner head
 )
  (setq T2 (POLAR T1 (DTR 180.0) NOSING)
   )
    (setq T4 (POLAR T2 (DTR 90.0) TRTH)
     )
      (setq T5 (POLAR IP (DTR 90.0) RISE)
       ) 
        (setq T6 (POLAR T5 (DTR 0.0) GOING)
         )
          (setq T7 (POLAR T6 (DTR 270.0) TRTH)
           )
            (setq T8 (POLAR T7 (DTR 180.0) (- GOING RITH))
             )
              (setq T9 (POLAR T2 (DTR 0.0) (/ TRTH 2))
               )
                (setq T10 (POLAR T4 (DTR 0.0) (/ TRTH 2))
                 )
                  (setq T3 (POLAR T9 (DTR 90.0) (/ TRTH 2))               ;centre point for tread nosing
                   )
;=========================================================================================;
(setvar "OSMODE" 0)
       (SLL "Riser" "72" "CONTINUOUS")    ;Go to SLL Layer Function, Set Layer, Color & Linetype
      (command "_.PLINE" IP R1 R2 R3 R4 R5 IP ""
     ); riser drawn
;=========================================================================================;
;plot tread elevation
                  (setvar "OSMODE" 0)
                 (SLL "Tread" "63" "CONTINUOUS")        ;Go to SLL Layer Function, Set Layer, Color & Linetype
                (command "_.PLINE" T10 T5 T6 T7 T8 R2 R1 T1 T9 ""
       )
              (command "arc" "c" T3 T10 T9
     )                 ;nosing
            (setvar "OSMODE" 0)
           (SLL "Riser" "72" "HIDDEN")                  ;Go to SLL Layer Function, Set Layer, Color & Linetype
          (command "_.PLINE" N1 N2 ""
         )         ;draw first riser line plan view
        (setvar "OSMODE" 0)
       (SLL "Tread" "63" "CONTINUOUS")                  ;Go to SLL Layer Function, Set Layer, Color & Linetype
      (command "_.PLINE" N6 N1 N3 N4 N2 N5 ""
     )
    (setq PL4 (POLAR N6 (DTR 270.00) TRENCH)
   )
  (setq IP T6) ;place insert point at last t6 point
 )                                         ;end repeat loop
;=========================================================================================;
; Information Bar
; Mtext Total Rise Total Going Riser Width Height Tread Width Length Thick String length width thick
 ;width across strings tread groove width depth Trenching depth Pitch point to point on pitch line
  (setq TORI (* STEPS RISE))
  (setq TOGO (* STEPS GOING))
      (setq TRDT (+ NOSING GOING))
   
 
  ;=========================================================================================;
  (defun TextAdd (txt TXPP ht lay)
      (entmakex
        (list (cons 0 "TEXT")
              (cons 1 txt) ;* (the string itself)
              (cons 6 "BYLAYER") ; Linetype name
              (cons 8 (if lay lay (getvar "CLAYER")))   ; layer
              (cons 10 TXPP) ;* First alignment point (in OCS)
              (cons 11 TXPP) ;* Second alignment point (in OCS) ;;not sure I totally understand this alignment point
              (cons 40 10.0) ;* Text height;; changed to set the text height I want to use
              (cons 50 0.0) ; Text rotation angle
              (cons 71 0) ; Text generation flags
              (cons 72 0) ; Horizontal text justification type
              (cons 73 0) ; Vertical text justification type
      (cons 210 (list 0.0 0.0 1.0))))) ;Code Courtesy of CAB
 

  ;=========================================================================================;
     
  (setq TXPP (getpoint "\nPick the point for the Text: "))
               (TextAdd (strcat "Total Rise Is:" (rtos TORI 2 2) "  Total Going Is:" (rtos TOGO 2 2)) TXPP TXTHT nil)
      (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
      (TextAdd (strcat " Risers Are: " (rtos RWTW 2 2)" By " (rtos RITH 2 2)" By "(rtos RIHT 2 2)) TXPP TXTHT nil)
        (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
         (TextAdd (strcat " Treads Are: "(rtos RWTW)" By "(rtos TRTH)" By "(rtos TRDT)) TXPP TXTHT nil)
          (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
           (TextAdd (strcat "Pitch Of Stair: " (angtos (atan RISE GOING) 0 2)" Degrees") TXPP TXTHT nil)
            (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
   
 

     
;=========================================================================================;
(setvar "CLAYER" OLDLAY)
(setvar "OSMODE" OLDSNAP)
(setvar "BLIPMODE" OLDBLIP)
(setvar "HIGHLIGHT" OLDLIGHT)
(princ)
);defun
Rob.

[Tharwat]

Here it is complete now.  Buddy 

Check it out .

Code: [Select]

(defun C:stair3 (/ IP GOING RISE NOSING TRTH RITH STRTH WIDE STEPS a AA B C D E F G H K S N P
Q R R1 R2 R3 R4 R5 T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 S1 S2 S3 S4 S5 S6 S7 S8 S9
PT1 PT2 PL1 PL2 PL3 PL4 PL5 PL6 PL7 PL8 PL9 PL10 N1 N2 N3 N4 N5 N6 N7 N8 N9 N10
RWTW TRENCH LEN ANG TXPP TXTPT TXTHT TOGO TORI TRDT prntxt OLDSNAP OLDBLIP OLDLIGHT OLDLAY)
;=========================================================================================;
; lisp routine to draw basic timber staircase, side elevation and plan view
; by Rob-GB 27.01.2011
; Acknowledgements are due to the many members of Cadtutor and The Swamp who give freely of their time and knowledge.
; Thanks
(setq OLDSNAP (getvar "OSMODE")
)
(setq OLDBLIP (getvar "BLIPMODE") ;store settings
)
(setq OLDLIGHT (getvar "HIGHLIGHT")
)
(setq OLDLAY (getvar "CLAYER")
)
(setvar "CMDECHO" 0)
        (setvar "BLIPMODE" 0)
;=========================================================================================;
;Basic dims required
;=========================================================================================;
(or GOING (setq GOING 230.0)) ;set default dims and allow user input
(or RISE (setq RISE 200.0))
  (or TRTH (setq TRTH 25.0))
   (or RITH (setq RITH 9.0))
    (or WIDE (setq WIDE 900.0))
     (or STRTH (setq STRTH 33.0))
              (or NOSING (setq NOSING 25.0))
         (or STEPS (setq STEPS 13.0))
        (setq AA (rtos GOING 2 1))
(setq B (rtos RISE  2 1))
  (setq C (rtos TRTH  2 1))
           (setq D (rtos RITH  2 1))
    (setq E (rtos WIDE  2 1))
     (setq F (rtos STRTH 2 1))
              (setq G (rtos NOSING 2 1))
                 (setq H (rtos STEPS 2 1))
 
(setq GOING (cond ((getdist (strcat "\nEnter going of tread <"AA">:")))     (T (setq GOING GOING))))
(setq RISE  (cond ((getdist (strcat "\nEnter rise of step <"B">:")))       (T (setq RISE RISE))))
(setq TRTH  (cond ((getdist (strcat "\nEnter tread thickness <"C">:")))    (T (setq TRTH TRTH))))
(setq RITH  (cond ((getdist (strcat "\nEnter riser thickness <"D">:")))    (T (setq RITH RITH))))
(setq WIDE  (cond ((getdist (strcat "\nEnter width across strings <"E">:")))      (T (setq WIDE WIDE)))) 
(setq STRTH (cond ((getdist (strcat"\nEnter string thickness <"F">:")))   (T (setq STRTH STRTH))))
(setq NOSING (cond ((getdist (strcat"\nEnter nosing projection <"G">:")))   (T (setq NOSING NOSING))))
(setq STEPS (getint "\nEnter number of risers : "))

(setq IP (getpoint "\nInsertion Point: ")
) ; bottom left finish floor level of first riser, stair will be drawn rising from left to right
;===============================================================================================================;
(defun DTR (a) (* PI (/ a 180.0)) ;degrees to radians
)
;===============================================================================================================;
;;; Layer Function - Set Layer & Linetype.                          ;Function Description
(defun SLL (NLAY CLR LT / LAY FRZ)                                  ;Define function, Declare local variables and arguments
  (setq LAY  (tblsearch "layer" NLAY))                              ;Search drawing to find layer, Note: (NOT USED)
   (if                                                              ;If the following returns true
    (not LAY)                                                       ;Layer not in drawing
     (command "_.layer" "m" NLAY "c" CLR "" "lt" LT "" "")          ;Layer command ~ make new layer with color and linetype
      (progn                                                        ;Then do the following
       (setq FRZ (cdr (assoc 70 LAY)))                              ;Variable FRZ is frozen layer
        (if (= FRZ 65)                                              ;Layer frozen from last edit
         (progn                                                     ;Then do the following
          (command "_.layer" "t" NLAY "")                           ;Thaw new layer if frozen
           (command "_.layer" "s" NLAY ""))                         ;Set new layer
            (command "_.layer" "s" NLAY ""))))                      ;Set new layer
)                                                                   ;End define function 
;=========================================================================================;
(setvar "OSMODE" 0) 
(setq P (* RISE RISE)
 )
  (setq Q (* GOING GOING)
   )
    (setq LEN (SQRT (+ P Q))
     )
      (setq PT1 (POLAR IP (DTR 90.0) RISE)
       )
        (setq PT2 (POLAR PT1 (DTR 0.0) GOING)
)
     
(setq S1 (POLAR IP (DTR 0.0) 100)
 )
  (setq S2 (POLAR IP (DTR 180.0) 150)
   )
    (setq S3 (POLAR S2 (DTR 90.0) 150)
     )
      (setq S4 (POLAR S3 (angle IP PT2) (* STEPS LEN))
       )
        (setq S5 (POLAR S4 (DTR 0.0) 250)
         )
          (setq S6 (POLAR S5 (DTR 270.0) 150)
           )
          (setvar "OSMODE" 0)
         (SLL "String" "63" "CONTINUOUS")      ;Go to SLL Layer Function, Set Layer, Color & Linetype
        (command "_.PLINE" S1 S2 S3 S4 S5 S6 S1 ""
       )
       ; string drawn
;============================================================================================================;
 ;Draw plan view of stair strings
(setq PL1 (POLAR IP (DTR 270.0) 150)
 )
  (setq PL2 (POLAR PL1 (DTR 180.0) 150)
   )
    (setq PL3 (POLAR PL2 (DTR 270.0) STRTH)
     )
      (setq PL4 (POLAR PL3 (DTR 0.0) 150)
       )
        (setq PL5 (POLAR PL4 (DTR 0.0) (+ (* STEPS GOING) 100))
         )
          (setq PL6 (POLAR PL5 (DTR 90.0) STRTH)
           )
      (setq PL7 (POLAR PL2 (DTR 270.0) WIDE)
       )
        (setq PL8 (POLAR PL6 (DTR 270.0) WIDE)
               )
                (setq PL9 (POLAR PL8 (DTR 90.0) STRTH)
                 )
                  (setq PL10 (POLAR PL7 (DTR 90.0) STRTH)
                   ) ;plan view string outlined
;============================================================================================================;
                  (setvar "OSMODE" 0)
(SLL "String" "63" "CONTINUOUS")     ;Go to SLL Layer Function, Set Layer, Color & Linetype
       (command "_.PLINE" PL1 PL2 PL3 PL4 PL5 PL6 PL1 ""
      )
             (command "_.PLINE" PL7 PL8 PL9 PL10 PL7 ""
    )       ; string drawn
;============================================================================================================;
(repeat STEPS
 (setq TRENCH 12)
  (setq RWTW (- WIDE (* STRTH 2))
   )
(setq N1 (POLAR PL4 (DTR 90.0) TRENCH) ;THIS COULD BE CHANGED TO HOUSING DEPTH WITH NEW QUESTION AT START
 )
  (setq N2 (POLAR N1 (DTR 270.0) (+ RWTW (* TRENCH 2)))
   )
    (setq N3 (POLAR N1 (DTR 180.0) NOSING)
     )
      (setq N4 (POLAR N3 (DTR 270.0) (+ RWTW (* TRENCH 2)))
       )
        (setq N5 (POLAR N4 (DTR 0.0) GOING)
         )     
          (setq N6 (POLAR N1 (DTR 0.0) GOING)
           )       
;============================================================================================================;
;set other dims
(setq GR 10) ;sets depth of groove in tread to accept riser
  (setq GRD (- TRTH GR)) ;gives tread thickness less riser groove depth
 
;=========================================================================================;
; plot points for side elevation
(setq R1 (POLAR IP (DTR 90.0) (- RISE GRD)) ; riser side elevation from insert point
 )
  (setq R2 (POLAR R1 (DTR 0.0) RITH)
   )
    (setq R3 (POLAR R2 (DTR 270.0) (- RISE GRD))
     )
      (setq R4 (POLAR R3 (DTR 270.0) TRTH)
       )
        (setq R5 (POLAR R4 (DTR 180.0) RITH)
         )
;====================================================================================;
;treads
(setq T1 (POLAR R1 (DTR 270.0) GR) ; top corner head
 )
  (setq T2 (POLAR T1 (DTR 180.0) NOSING)
   )
    (setq T4 (POLAR T2 (DTR 90.0) TRTH)
     )
      (setq T5 (POLAR IP (DTR 90.0) RISE)
       ) 
        (setq T6 (POLAR T5 (DTR 0.0) GOING)
         )
          (setq T7 (POLAR T6 (DTR 270.0) TRTH)
           )
            (setq T8 (POLAR T7 (DTR 180.0) (- GOING RITH))
             )
              (setq T9 (POLAR T2 (DTR 0.0) (/ TRTH 2))
               )
                (setq T10 (POLAR T4 (DTR 0.0) (/ TRTH 2))
                 )
                  (setq T3 (POLAR T9 (DTR 90.0) (/ TRTH 2))               ;centre point for tread nosing
                   )
;=========================================================================================;
(setvar "OSMODE" 0)
       (SLL "Riser" "72" "CONTINUOUS")    ;Go to SLL Layer Function, Set Layer, Color & Linetype
      (command "_.PLINE" IP R1 R2 R3 R4 R5 IP ""
     ); riser drawn
;=========================================================================================;
;plot tread elevation
                  (setvar "OSMODE" 0)
                 (SLL "Tread" "63" "CONTINUOUS")        ;Go to SLL Layer Function, Set Layer, Color & Linetype
                (command "_.PLINE" T10 T5 T6 T7 T8 R2 R1 T1 T9 ""
       )
              (command "arc" "c" T3 T10 T9
     )                 ;nosing
            (setvar "OSMODE" 0)
           (SLL "Riser" "72" "HIDDEN")                  ;Go to SLL Layer Function, Set Layer, Color & Linetype
          (command "_.PLINE" N1 N2 ""
         )         ;draw first riser line plan view
        (setvar "OSMODE" 0)
       (SLL "Tread" "63" "CONTINUOUS")                  ;Go to SLL Layer Function, Set Layer, Color & Linetype
      (command "_.PLINE" N6 N1 N3 N4 N2 N5 ""
     )
    (setq PL4 (POLAR N6 (DTR 270.00) TRENCH)
   )
  (setq IP T6) ;place insert point at last t6 point
 )                                         ;end repeat loop
;=========================================================================================;
; Information Bar
; Mtext Total Rise Total Going Riser Width Height Tread Width Length Thick String length width thick
 ;width across strings tread groove width depth Trenching depth Pitch point to point on pitch line
  (setq TORI (* STEPS RISE))
  (setq TOGO (* STEPS GOING))
      (setq TRDT (+ NOSING GOING))
   
 
  ;=========================================================================================;
  (defun TextAdd (txt TXPP ht)
      (entmakex
        (list (cons 0 "TEXT")
              (cons 1 txt) ;* (the string itself)
              (cons 6 "BYLAYER") ; Linetype name
              (cons 8 (if lay lay (getvar "CLAYER")))   ; layer
              (cons 10 TXPP) ;* First alignment point (in OCS)
              ;(cons 11 TXPP) ;* Second alignment point (in OCS) ;;not sure I totally understand this alignment point
              (cons 40 10.0) ;* Text height;; changed to set the text height I want to use
              (cons 50 0.0) ; Text rotation angle
              (cons 71 0) ; Text generation flags
              (cons 72 0) ; Horizontal text justification type
              (cons 73 0) ; Vertical text justification type
      (cons 210 (list 0.0 0.0 1.0))))) ;Code Courtesy of CAB
 

  ;=========================================================================================;
      (setq TXTHT 10.)
  (setq TXPP (getpoint "\nPick the point for the Text: "))
               (TextAdd (strcat "Total Rise Is:" (rtos TORI 2 2) "  Total Going Is:" (rtos TOGO 2 2)) TXPP TXTHT)
     (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
   (TextAdd (strcat "Risers Are: " (rtos RWTW 2 2)" By " (rtos RITH 2 2)" By "(rtos RITH 2 2)) TXPP TXTHT)
        (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
         (TextAdd (strcat "Treads Are: "(rtos RWTW)" By "(rtos TRTH)" By "(rtos TRDT)) TXPP TXTHT)
          (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
           (TextAdd (strcat "Pitch Of Stair: " (angtos (atan RISE GOING) 0 2)" Degrees") TXPP TXTHT )
            (setq TXPP (polar TXPP (DTR 270.0) (+ TXTHT 2)))
   
 

     
;=========================================================================================;
(setvar "CLAYER" OLDLAY)
(setvar "OSMODE" OLDSNAP)
(setvar "BLIPMODE" OLDBLIP)
(setvar "HIGHLIGHT" OLDLIGHT)
(princ)
);defun

[BlackBox]

For your consideration -

If you desire to use entmake* functions, then consider removing the uneccessary cons statements:

Code: [Select]

(defun TextAdd  (txt TXPP ht lay)
    (entmakex
      (list '(0 . "TEXT")
            (cons 1 txt)
            '(6 . "BYLAYER")
            (cons 8
                  (if lay
                    lay
                    (getvar "CLAYER")))
            (cons 10 TXPP)
            (cons 11 TXPP)
            (cons 40 ht)
            '(50 . 0.0)
            '(71 . 0)
            '(72 . 0)
            '(73 . 0)
            '(210 0.0 0.0 1.0))))

Also, as an alternative, consider ActiveX in doing the same task:

Code: [Select]

(defun TextAdd2  (txt TXPP ht lay / activeDoc)
    (vl-load-com)
    (setq activeDoc (vla-get-activedocument (vlax-get-acad-object)))
    (if (not (tblsearch "layer" lay))
      (vla-add (vla-get-layers activeDoc) lay))
    (vla-put-layer
      (vla-addtext
        (cond ((= "MODEL" (strcase (getvar 'ctab)))
               (vla-get-modelspace activeDoc))
              ((vla-get-paperspace activeDoc)))
        txt
        (vlax-3d-point TXPP)
        ht)
      lay))

Cheers! :beer:

[David Bethel]

Every time I see this thread I think some thing like GRTEXT only in the graphscr so:

Code: [Select]

(defun c:grtxt (/ ts cp)
  (setq ts (strcase (getstring t "\nText String:   ")))
  (initget 1)
  (setq cp (getpoint "\nText Middle Left Point:   "))
  (grtxt ts cp)
  (prin1))

(defun grtxt (ts cp / bp ltb i xp z c p1 p2 lp ld)
(setq bp '((1 ( 0.50 0.25))
           (2 ( 0.50 0.55))
           (3 ( 0.50 0.85))
           (4 ( 0.50 1.00))
           (5 ( 0.25 1.00))
           (6 ( 0.00 1.00))
           (7 (-0.25 1.00))
           (8 (-0.50 1.00))
           (9 (-0.50 0.85))
          (10 (-0.50 0.55))
          (11 (-0.50 0.25))
          (12 (-0.50 0.10))
          (13 (-0.25 0.10))
          (14 ( 0.00 0.10))
          (15 ( 0.25 0.10))
          (16 ( 0.50 0.10))
          (17 ( 0.50 -0.05))
          (18 ( 0.50 -0.45))
          (19 ( 0.50 -0.85))
          (20 ( 0.50 -1.00))
          (21 ( 0.25 -1.00))
          (22 ( 0.00 -1.00))
          (23 (-0.25 -1.00))
          (24 (-0.50 -1.00))
          (25 (-0.50 -0.85))
          (26 (-0.50 -0.40))
          (27 (-0.50 -0.05))

          (30 ( 0.375  0.875))
          (31 (-0.375  0.875))
          (32 (-0.375 -0.875))
          (33 ( 0.375 -0.875))

          (40 ( 0.20   0.20))
          (41 (-0.20   0.20))
          (42 ( 0.20  -0.20))
          (43 (-0.20  -0.20))
          (44 ( 0.00   0.35))
          (45 ( 0.00  -0.35))))

  (setq ltb '(("A" 24 9 7 5 3 20 16 12)
              ("B" 12 15 1 3 5 8 24 21 19 17 15)
              ("C" 3 5 7 9 25 23 21 19)
              ("D" 3 5 8 24 21 19 3)
              ("E" 4 8 12 15 12 24 20)
              ("F" 4 8 12 15 12 24)
              ("G" 3 5 7 9 25 23 21 19 16 15)
              ("H" 20 -4 8 -24 16 12)
              ("I" 7 5 6 22 23 21)
              ("J" 4 19 21 23 25)
              ("K" 8 24 12 13 4 13 20)
              ("L" 8 24 20)
              ("M" 24 8 14 4 20)
              ("N" 24 8 20 4)
              ("O" 3 5 7 9 25 23 21 19 3)
              ("P" 12 15 1 3 5 8 24)
              ("Q" 3 5 7 9 25 23 21 19 3 -19 20 45)
              ("R" 20 14 12 15 1 3 5 8 24)
              ("S" 3 5 7 9 11 13 15 17 19 21 23 25)
              ("T" 4 8 6 22)
              ("U" 8 25 23 21 19 4 20)
              ("V" 8 22 4)
              ("W" 8 23 14 21 4)
              ("X" 4 -24 8 20)
              ("Y" 8 14 22 14 4)
              ("Z" 8 4 14 13 15 14 24 20)
              ("0" 3 5 7 9 25 23 21 19 -3 4 24)
              ("1" 9 7 6 22 21 23)
              ("2" 9 7 5 3 1 15 13 27 24 20)
              ("3" 9 7 5 3 1 15 13 15 17 19 21 23 25)
              ("4" 8 12 16 20 4)
              ("5" 4 8 12 15 17 19 21 23 25)
              ("6" 3 5 7 9 25 23 21 19 17 15 12)
              ("7" 8 4 22)
              ("8" 3 5 7 9 11 13 27 25 23 21 19 17 15 13 15 1 3)
              ("9" 25 23 21 19 3 5 7 9 11 13 16)
              ("<" 4 12 20)
              (">" 8 16 24)
              ("," 33 21)
              ("." 19 20 21 19)
              ("\'" 4 30 )
              ("\"" 4 -30 7 31)
              (";" 14 44 40 14 42 45 43 42)
              (":" 14 44 40 14 42 45 14)
              ("\\" 8 20)
              ("/" 4 24)
              ("?" 11 10 7 5 2 1 45 22)
              ("|" 6 -44 45 22)
              ("+" 44 -45 13 15)
              ("=" 40 -41 42 43)
              ("-" 13 15)
              ("_" 20 24)
              (")" 6 2 18 22)
              ("(" 6 10 26 22)
              ("*" 40 -43 41 -42 44 45)
              ("&" 21 31 7 6 26 25 23 16)
              ("^" 10 6 2)
              ("%" 41 12 11 -41 30 -32 42 16 17 42)
              ("$" 3 5 7 9 11 13 15 17 19 21 23 -25 22 6)
              ("#" 24 -6 22 -4 1 -11 17 27)
              ("@" 14 42 15 40 44 41 13 43 45 42 17 3 5 7 9 25 23 21 19)
              ("!" 6 -45 21 22)
              ("~" 9 31 44 40 2)
              ("")))

(setq z (/ (getvar "VIEWSIZE") 66.)
     xp (list (+ (car cp) z) (cadr cp))
      i 1)

(repeat (strlen ts)
  (setq c (substr ts i 1))
  (setq lp '()
        ld (cdr (assoc c ltb)))
  (repeat (1- (length ld))
          (setq p1 (cadr (assoc (abs (nth 0 ld)) bp))
                p2 (cadr (assoc (abs (nth 1 ld)) bp))
                p1 (mapcar '* (list z z) p1)
                p2 (mapcar '* (list z z) p2)
                p1 (mapcar '+ xp p1)
                p2 (mapcar '+ xp p2)
                lp (append lp (list (if (minusp (nth 0 ld)) -0 4) p1 p2))
                ld (cdr ld)))
   (and lp (grvecs lp))
   (setq xp (list (+ (car xp) (* z 1.5)) (cadr xp))
          i (1+ i)))

   (prin1))

Just for fun anyway.  -David

[CAB]

That is fun David.
Did you consider the SPACE character?

[Rob-GB]

Thanks Tharwat but even with the couple of changes you made it will still only print the first line of text.
I took out the (cons 11 TXP)  but still don't know what it is really for.
; error: bad argument type: numberp: nil is what I get when the routine fails.

Thanks Renderman and David, but some of that coding is way past me at the moment.

  Rob.