TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: CAB on April 11, 2005, 12:20:23 PM
-
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.
-
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.
-
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.
-
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!
-
Thanks for the kind words.
When I right click it goes to the prompt. (ACAD2000)
Wonder if that is sys var setting?
-
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.
-
Let me know how your test went.
I got used to using this Pl2cloud (http://www.theswamp.org/phpBB2/viewtopic.php?t=1319) for revision notes.
But I do have another box in mind. Haven't tackled it yet as it's a little complicated.
(http://www.theswamp.org/lilly.pond/CAB/Rev%20Cloud.jpg)
PS I'd be more that happy to take a look at your r-cloud code, though.
-
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. :lol:
code:
;;;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).
:)
-
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:
(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]
-
I think you can use this to wait until the right button is released:
(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.
-
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 (http://theswamp.org/lilly_pond/cab/TextBox-CAB%2004.Lsp?nossi=1)
-
(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
-
Something like this perhaps ..
(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))(http://www.theswamp.org/screens/kerry/TextBoxer.png)
-
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])
-
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.
(http://www.theswamp.org/screens/cab/TxtBox.png)
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 {}
}
}
-
How about this:
(http://www.theswamp.org/screens/Crank/txtbox.JPG)
dcl_settings : default_dcl_settings { audit_level = 3; }
txtbox : dialog {
label = " Text Box by CAB v2.05";
: boxed_column {
label = "< Select Box Style >";
key = "bstyles";
is_tab_stop = false;
: row {
key = "row1";
: image_button {
key = "button1-1";
color = graphics_background;
width = 20;
height = 6;
}
: image_button {
key = "button1-2";
color = graphics_background;
width = 20;
height = 6;
}
: image_button {
key = "button1-3";
color = graphics_background;
width = 20;
height = 6;
}
}
: row {
key = "row2";
: image_button {
key = "button2-1";
color = graphics_background;
width = 20;
height = 6;
}
: image_button {
key = "button2-2";
color = graphics_background;
width = 20;
height = 6;
}
: image_button {
key = "button2-3";
color = graphics_background;
width = 20;
height = 6;
}
}
: row {
key = "row3";
: image_button {
key = "button3-1";
color = graphics_background;
width = 20;
height = 6;
}
: image_button {
key = "button3-2";
color = graphics_background;
width = 20;
height = 6;
}
: image_button {
key = "button3-3";
color = graphics_background;
width = 20;
height = 6;
}
}
: row {
key = "row4";
: image_button {
key = "button4-1";
color = graphics_background;
width = 20;
height = 6;
}
: image_button {
key = "button4-2";
color = graphics_background;
width = 20;
height = 6;
}
: image_button {
key = "button4-3";
color = graphics_background;
width = 20;
height = 6;
}
}
}
: boxed_row {
key = "brow";
alignment = centered;
: popup_list {
label = "Offset Base Amount";
key = "offset";
edit_width = 8;
}
: toggle {
label = "times DimScale =";
key = "dimsc";
mnemonic = "D";
}
: text {
value = "XXX";
key = "ofamt";
width = 10;
}
}
spacer_1;
ok_cancel_help;
spacer_1;
}
-
That look good but I only have 10 box styles.
Just kidding.. :D
I just thought the pick list would allow adding box styles
without impacting the DCL file but that may not be a real
issue. Your Offset input looks good.
Thanks Crank..
-
You could do a combination of the two options and have a preview pane on the side for the currently selected style of box. :D
my 2c
-
Did you just describe my dialog box? :roll:
See the picture above Cranks post.
The white rectangle is the pick box & the black one is the preview pane. :)
-
Update just in...
This is version 2.05
Comments welcome as always.
(http://www.theswamp.org/screens/cab/TextBox%202.05.png)
-
DOSLIB ROCKS! Wheres that headbanger when you need him.
-
Did you just describe my dialog box? :roll:
See the picture above Cranks post.
The white rectangle is the pick box & the black one is the preview pane. :)
[Homer Simpson]
Dote!!
[/Homer Simpson]
I missed your previous post CAB. Yes I like the one preview on the side better than 9 previews at once. It also adds some flexibility if you wanted to add more in the future. You already have the groud work laid out. :-D
-
(http://www.theswamp.org/screens/TimSpangler/LC2.0.PNG)
CAB or anyone else for that matter,
Just a suggestion on the appearance, I see that you use 2 seperator lines on you dialog, Maybe try something like the one I used on this dialog for more of a system look? I stumbled upon this by accident. draw 2 line in acad one grey and one white, with a slight gap between them, create a slide then load it using dialog_background as the back color and this is what you get.
-
Tim,
Good suggestion.. I was able to create the same with a vector image.
: image {
key = "bar1";
width = 33.26;
height = 0.74;
color = -15;
}
(start_image "bar1")
(mapcar 'vector_image '(0) '(6) '(200) '(6) '(8))
(mapcar 'vector_image '(0) '(5) '(200) '(5) '(7))
(end_image)
(start_image "bar2")
(mapcar 'vector_image '(0) '(6) '(200) '(6) '(8))
(mapcar 'vector_image '(0) '(5) '(200) '(5) '(7))
(end_image)
Don't understand all the ins & outs of vector images, width, height, etc.
But it works.
(http://www.theswamp.org/screens/cab/TextBox%202.05a.png)
-
Sorry Allen <I know your not Tim>, your txtbox routine works great. My bad.
I know I will be learning from it. Thanks for sharing it. I'm still new to this group, trying to catch up.
Gary
-
So the sbox tile is an image tile with the vectors within it.
Didn't know you could do that, very cool.
Why the different multiplier values in SBOX-IMG1 and SBOX-IMG2
i.e. [0.11 0.11 0.91 0.909] as apposed to this [0.125 0.125 0.925 0.925]
Gotta run.
-
Added another box style to this old routine. :-)
See the first post.
-
CAB,
Is there a slide lib. file that needs to go with this, getting error bt-single.sld file not in ACAD path.
Bruce
-
Sorry about that folks.
I uploaded a Zip file with slides & Lisp.
Make sure the slides are in the ACAD path. 8-)
-
Added shadows to the new shapes.
Same version 2.5 but uploaded the new zip file in first post.
-
CAB,
Wondering if there is a reason for not utilizing a single slide library file, instead of individual slides. Not being critical of your work, just seeing if you know of any drawbacks using a Library file.
Bruce
-
No reason other than I view this lisp as a work in progress.
Just never finished it. :-)
-
Hi CAB,
Thanks for sharing your favourite.
I like this, too.
Just one thing I found, the "plinewid" should reset to "0" after a heavy (line) box is drawn.
It will drawing cloud box with heavy line latter, otherwise.
Also, I cannot see previews in the dialog for:
1) Fileted Retangle - Drop Shadow
2) Frame
3) Frame Shadow
4) Cloud
-
Thanks for the feed back. :-)
Corrected the width error & added the missing slides.
See post one for the updated zip file.
-
Sorry CAB, I cannot found the zip file but the lsp file in your 1st post.
-
In my haste I grabbed the wrong file. :oops:
It is there now.
-
my dtext bbox code:
-
Good first effort.
-
Cool stuff 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.
-
Thanks 8-)