Topic: Text Box Routine

[CAB]

If anyone has any suggestions or comments please do.
Excuse the messy lisp, work in progress you know.
It will create the boxes shown in the picture.
It supports mtext and dtext, rotated or not & UCS other that world.
It supports groups of dtext.
The selection method for the type of box is command line at this time but
may go to a dialog box or image menu in the future.
I use DimScale to determine the offset of the box. This does not give the
proper gap while in paper space, so I'll have to work on that. I could use
some suggestions here as I don't normally place text in paper space.
<update to v2.5 12/18/12>   Bug fix to 12/14/12 version.

[MP]

I wrote one of those years ago, but I must say mine isn't as versatile as yours as the screen grab illustrates. While I don't have time to test this for you I can say it's nice work Charles. For the box offset mine was a function of the text height, 0.75x IIRC.

[CAB]

Thanks MP, for the input.
I though about using the text height & even assigned it to a variable.
But decided not to use it at this time because of this scenario
If the user has a group of dtext with a title say 10" in height and the
body of text at say 5" in height the gap would differ from a group that
was all 5" text. I chose to use the first text entity in the selection
set to get the rotation & height from. Which might get me in trouble but
haven't seen a problem yet.

I think I will give your suggestion a try though & see what the results are.
That would solve my paper space text problem.

[nivuahc]

I tried it.

I like it.

I think it's damned sweet.

The command-line type select... if I use my mouse (as I always do) to finish my selection set (i.e. right-click) it skips right past the type selection prompt and draws a default plain rectangle. I can only get the type select prompt if I use the keyboard to close my selection.

A dialog would be fairly simply and not need to be run by default (although I have to say I love the TAB and BS thing). If it were an option on the command line to either select ENTER for the previously selected style or <Select Box Style>; to get a dialog with a list to choose from...

Just thinkin' out loud.

Great work as usual CAB!

[CAB]

Thanks for the kind words.
When I right click it goes to the prompt. (ACAD2000)
Wonder if that is  sys var setting?

[whdjr]

CAB,

I haven't tried it, yet; but I will shortly.  It might be useful for some to use it as a revision note - you know with the revision cloud as an option around it.  I have some old code I can send you if you don't already have any (which you probably do).  Aside from that it looks really cool and usefull.

[CAB]

Let me know how your test went.
I got used to using this Pl2cloud for revision notes.
But I do have another box in mind. Haven't tackled it yet as it's a little complicated.


PS I'd be more that happy to take a look at your r-cloud code, though.

[whdjr]

Alright CAB, you asked for it.  Here's my OLD and NASTY revcloud routine.  But as Chuck said in another post, it works so it's not wrong.

code:

Code: [Select]

;;;This program was written to provide a polygonal revision            
;;;cloud because the one written in Autocad 2000 was not very good.    
;;;This routine was a compilation of code from different members      
;;;of the AUGI Lisp Guild.                                            
;;;                                                                    
;;;This routine was written and compiled by Will DeLoach.              
;;;                                                                    
;;;Although I'm sure I will leave someone out here is an attempt      
;;;to name some of the major contributors:                            
;;;Peter Jamtgaard, Stig Madsen, Robert Bell, and the rest of the      
;;;Augi Lisp Guild members.                                            
;;;                                                                    
;;;This is not a copyrighted work.  This is for public use and        
;;;modification.
(defun *acad* ()
  (vlax-get-acad-object)
)

(defun *adoc* ()
  (vla-get-activedocument (*acad*))
)

(defun *3d->2d* (3dpt)
  (list (float (car 3dpt)) (float (cadr 3dpt)))
)

(defun *modelspace* ()
  (vla-get-modelspace (*adoc*))
)

(defun *paperspace* ()
  (vla-get-paperspace (*adoc*))
)

(defun c:rc2 (/ eobj   dist      extg_coords    point_list num
    pt_length stParam   endParam   new_pt_list    coord_list nextParam
    segdist segdiv   pt      pt_list bulge    val       ss
    word kword      cntr
   )
  (initget (+ 1 8) "Select")
  (setq word (getpoint
      "\nSpecify first point or Select a closed polyline [Select]: "
    )
  )
  (cond ((vl-consp word) (main_program (new_pline word)))
((= word "Select")
(while (not ss)
  (setq ss   (ssget '((0 . "LWPOLYLINE") (42 . 0.0) (70 . 1)))
cntr 0
  )
  (if ss
    (repeat (sslength ss)
      (main_program (vlax-ename->vla-object (ssname ss cntr)))
      (setq cntr (1+ cntr))
    )
    (Prompt "\nNothing selected.  Please try again:  ")
  )
)
)
  )
  (princ)
)
;;;                                                                    
;;;This is the Main program                                            
;;;                                                                    
(defun main_program (eobj)
  (vla-startundomark (*adoc*))
  (vla-highlight eobj :vlax-true)
  (vla-update eobj)
  (while (not dist)
    (setq dist (getdist
"\nPick two points for the Revision cloud distance or Type in distance:  "
      )
    )
    (if (and (and ss cntr)
    (and (> (sslength ss) 1)
 (< cntr 1)
    )
)
      (progn
(initget (+ 2 4) "Individual Global")
(setq
 kword (getkword
 "\nIs this an Individual or Global distance [Individual/Global] <Individual>:  "
)
)
      )
    )
    (cond ((= kword nil) (setq flag nil))
 ((= kword "Individual") (setq flag nil))
 ((= kword "Global") (setq flag T))
    )
  )
  (setq extg_coords (vlax-safearray->list
     (vlax-variant-value
(vla-get-coordinates eobj)
     )
   )
point_list  (xy_list extg_coords)
num    0
pt_length   (length point_list)
stParam    (vlax-curve-getStartParam eobj)
endParam    (vlax-curve-getEndParam eobj)
new_pt_list nil
  )
  (while (< num pt_length)
    (setq new_pt_list (cons (nth num point_list) new_pt_list)
 nextParam   (1+ stParam)
 segdist     (- (vlax-curve-getDistAtParam eobj nextParam)
(vlax-curve-getDistAtParam eobj stParam)
     )
 segdiv      dist
 pt_list     nil
    )
    (while (< segdiv segdist)
      (setq pt   (*3d->2d*
    (vlax-curve-getPointAtParam
      eobj
      (+ stParam
 (/ segdiv
    segdist
 )
      )
    )
  )
   segdiv (+ segdiv dist)
      )
      (setq pt_list (cons pt pt_list))
    )
    (setq stParam (1+ stParam))
    (setq new_pt_list (append pt_list new_pt_list))
    (setq num (1+ num))
  )
  (setq new_pt_list (reverse new_pt_list)
coord_list  nil
  )
  (foreach item new_pt_list
    (setq coord_list (cons (car item) coord_list))
    (setq coord_list (cons (cadr item) coord_list))
  )
  (setq coord_list (reverse coord_list))
  (vla-put-coordinates eobj (*make-array* coord_list))
  (vl-cmdf "._undo" "begin")
  (vla-setbulge eobj 0 1)
  (vla-update eobj)
  (setq stParam (vlax-curve-getStartParam eobj)
midPt (*3d->2d*
 (vlax-curve-getPointAtDist
   eobj
   (vlax-curve-getDistAtParam
     eobj
     (/ (- (+ 1 stParam) stParam) 2)
   )
 )
)
  )
  (if (= (inpoly eobj midPt) T)
    (setq val 1)
    (setq val -1)
  )
  (vl-cmdf "._U")
  (setq num 0)
  (while (< num (length new_pt_list))
    (setq new_bulge (vla-setbulge eobj num val))
    (setq num (1+ num))
  )
  (vla-highlight eobj :vlax-false)
  (vla-update eobj)
  (if (not flag)
    (setq dist nil)
  )
)
;;;                                                              
;;;This takes a list of numbers and returns a list of x and y    
;;;coordinates.                                                  
;;;                                                              
(defun xy_list (alist / cnt dlist)
  (setq cnt 0)
  (repeat (/ (length alist) 2)
    (setq dlist (cons (list (nth cnt alist)
   (nth (+ 1 cnt) alist)
     )
     dlist
)
 cnt (+ 2 cnt)
    )
  )
  (setq dlist (reverse dlist))
  dlist
)
;;;                                                              
;;;This was provided by Kerry Brown                              
;;;                                                              
(defun inpoly (eobj testpt / space objray angvar inside vartestpt)
  (setq inside  0
angvar  0
vartestpt (vlax-3d-point testpt)
  )
  (if (= (vla-get-activespace (*adoc*)) 1)
    (setq space (*modelspace*))
    (setq space (*paperspace*))
  )
  (repeat 36
    (setq angvar (+ 10 angvar))
    (if
      (= 0
(rem (vlax-safearray-get-u-bound
(vlax-variant-value
 (vla-intersectwith
   eobj
   (setq
     objray (vla-addray
      space
      vartestpt
      (vlax-3d-point
(polar testpt (* pi (/ angvar 180.0)) 1)
      )
    )
   )
   acextendnone
 )
)
1
     )
     2
)
      )
       (setq inside (1+ inside))
       (setq inside (1- inside))
    )
    (vla-delete objray)
  )
  (vlax-release-object objray)
  (vlax-release-object space)
  (not (minusp inside))
)
;;;                                                                  
;;;This draws the new polyline.                                      
;;;                                                                  
(defun new_pline (pt / space pts coords coord_list pline)
  (vla-startundomark (*adoc*))
  (if (= (vla-get-activespace (*adoc*)) 1)
    (setq space (*modelspace*))
    (setq space (*paperspace*))
  )
  (setq lst   (reverse (polyline pt))
pts   (apply 'append (mapcar '*3d->2d* lst))
pline (vla-addlightweightpolyline space (*make-array* pts))
  )
  (vla-put-closed pline T)
  (vla-update pline)
  pline
)
;;;                                                                    
;;;This was taken in part from the expresstools (ACET-UI-FENCE-SELECT)
;;;and modified to fit this routine.  Special thanks to Peter Jamtgaard
;;;for showing me this usefull expresstool.                            
;;;                                                                    
(defun polyline (p1 / lst)
  (vla-startundomark (*adoc*))
  (while p1
    (cond ((equal (type p1) 'LIST)
  (setq lst (append (list p1) lst))
  (if (> (length lst) 1)
    (grdraw (car lst) (cadr lst) 7)
  )
 )
 ((equal p1 "Undo")
  (if (> (length lst) 1)
    (grdraw (car lst) (cadr lst) 0)
  )
  (setq lst (cdr lst)
p1  (car lst)
  )
 )
 ((equal p1 "Close")
  (if (> (length lst) 1)
    (grdraw (car lst) (last lst) 7)
  )
  (setq p1 nil)
 )
    )
    (if p1
      (progn
(initget "Undo Close _Undo Close" 128)
(if (> (length lst) 2)
 (setq p1
(getpoint
  p1
  "\nSpecify an option [Undo /Close] <Endpoint of line>: "
)
 )
 (setq p1 (getpoint
    p1
    "\nSpecify an option [Undo] <Endpoint of line>: "
  )
 )
)
      )
    )
  )
  (redraw)
  lst
)
;;;
;;;This is the end of this routine.                                    
;;;
;;;Any help to make it better would be greatly appreciated.            
;;;
(princ)

whew...I hope that wasn't too ugly.  If I had to do it again I would definitely change a few things (like about 90% of it).
 

[Crank]

Thanks for the kind words.
When I right click it goes to the prompt. (ACAD2000)
Wonder if that is  sys var setting?

I think you can use this to wait until the right button is released:

Code: [Select]


(while (= a 12)(setq a (car (grread T))))


It looks very promising, but I agree with nivuahc about the dialogbox.

2 remarks:

• Please place (command "_.undo" "begin") before you change any variables.
• Rotating the UCS is an easy (but dirty) solution: then you must also set UCSFOLLOW to 0.

A better way is use the trans function to find the points of the bounding box and to draw the new objects.[/list:u]

[CAB]

I think you can use this to wait until the right button is released:

Code: [Select]


(while (= a 12)(setq a (car (grread T))))


Why does it work fine for me?

Please place (command "_.undo" "begin") before you change any variables.

You got it.

Rotating the UCS is an easy (but dirty) solution: then you must also set UCSFOLLOW to 0.
A better way is use the trans function to find the points of the bounding box and to draw the new objects.

Care to give an example?
Perhaps I was not using the bounding box function correctly,
BUT it returned the coordinated in UCS World of the objects but not at the
angle needed for the box.
Try rotating the text 45 deg, then rotate the UCS 90 deg and get a bounding box
that will wrap the text. I would be grateful for the solution.

Thanks.

[CAB]

Long time but here is an update. Still not the finished routine.
I revised & added routines to deal with rotated & non world UCS with
text & mtext. Had to rewrite the box routines.
But I think I got most of the bugs.

What I need now is a good Dialog box design to start working on the front end and eliminate
the command line version. Any suggestions welcome. I am short of time as usual, so there
may be another lag for the Dialog box.

TextBox 2.04

[Kerry]

(dos_listbox title prompt list)
Displays a sizeable Windows dialog box with a single-selection list box.

.. just feed it your TYPES list ... game over.

http://www.mcneel.com/doslib.htm

[Kerry]

Something like this perhaps ..

Code: [Select]

(setq BoxStyleList (list "Single Light Rectangle"
                  "Single Light Rectangle with Fillet"
                  "Double Rectangle"
                  "Double Rectangle with Fillet"
                  "Heavy Rectangle"
                  "Heavy Rectangle with Fillet"
                  "Rectangle with Shadow"
                  "Filleted Rectangle with Shadow"
                  "Hand Drawn"
                  "Hand Drawn Double"))

(setq BoxStyle (dos_listbox "Text Boxer ..." "Select a Style" BoxStyleList) )

(setq BoxStyleIndex (vl-position BoxStyle BoxStyleList))

[Kerry]

skinning cats ....

.. or if you want to show the piccys ..

put a sample of each into a 'special' folder,
and use
(dos_dwgpreview title path [T])

[CAB]

Kerry, Thanks so much for the input.

This is what I came up with as a starting point.
And yes I will use slides to make it jazzy.

Having a little trouble formatting the Offset Area though.

Code: [Select]

dcl_settings : default_dcl_settings { audit_level = 3; }

txtbox : dialog {
    label = "   Text Box by CAB v2.05";
    : boxed_row {
        label = "< Select Box Style >";
        : list_box {
            key = "bstyles";
            width = 30;
            height = 20;
            multiple_select = true;
        }
        : column {
            : image_button {
              color  = 0;
              height = 7;
              width  = 18;
              key = "tbox";
            }

            : boxed_column {
           
            : edit_box {
                label = "Offset Base Amount";
                key = "ofset";
                edit_width = 6;
                edit_limit = 6;
                value = "0.125";
            }

           
            : row {
              : toggle {
                  key = "dimsc";
                  label = "times DimScale ->";
                  value = "1";
              }
              : text {
                  key = "dimscamt" ;
                  width = 6 ;
                  value = "48";
                  //alignment = top ;
              }
            }

            : text {
                key = "ofamt" ;
                width = 10 ;
                value = "Total Offset = 6.00";
                alignment = centered ;
            }


            } //  boxed column

              : spacer {
                height = 2;
              }

       }
    }
    : row {
    : button {
        label = "Add Box";
        key = "ok";
        mnemonic = "A";
    }
    : button {
        label = "Help";
        key = "help";
        mnemonic = "H";
    }
    : cancel_button {}
    }
}