View Full Version : Looking for a routine to draw a beam line with added text
terryh
2007-01-15, 04:27 AM
I need a lisp routine to draw a beam, supports & text to my structural floor plans. I am using LT2004 with a lisp enabler. I need to be able to draw a line (cyan / centerline) from point A to point B, add a beam number above the line at mid-point, and insert a solid square at each end of the line representing the columns, and then add text near these columns (at 45 degrees). Any help?
Lions60
2007-01-15, 01:09 PM
Could you post a drawing of what you are wanting. It woud help explain it better.
I need a lisp routine to draw a beam, supports & text to my structural floor plans. I am using LT2004 with a lisp enabler. I need to be able to draw a line (cyan / centerline) from point A to point B, add a beam number above the line at mid-point, and insert a solid square at each end of the line representing the columns, and then add text near these columns (at 45 degrees). Any help?
I have not have a LT but maybe this wil be
work for you
Tested on A2005 only
; multiple draw beam lines
(defun C:BML (/ ang lg num p1 p2 pc px rot rp1 rp2 rp3 rp4)
; Convert value in radians to degrees
(defun rtd (a)
(* 180.0 (/ a pi))
)
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(while
(setq p1 (getpoint "\nSpecify starting point (or press Enter to stop loop) >>"))
(setq p2 (getpoint p1 "\nSpecify ending point >>")
pc (mapcar (function (lambda(a b)(/ (+ a b) 2)))
p1 p2)
)
(setq num (getstring "\nEnter beam number: "))
(setq lg (/ (getreal "\nEnter box length: ") 2))
(setq ang (min (angle p1 p2) (angle p2 p1)))
(if (> ang (/ pi 2)) (setq ang (+ ang pi)))
(setq px (polar pc (+ ang (/ pi 2))(getvar "dimtxt")));change text height by suit
(command "._text" "j" "mc" px (rtd ang) num)
(command "._line" p1 p2 "")
(command "._chprop" (entlast) "" "_LT" "Center" "_C" "cyan" "")
(setq rp1 (list (- (car p1) lg)(- (cadr p1) lg))
rp2 (list (+ (car p1) lg)(+ (cadr p1) lg))
rp3 (list (- (car p2) lg)(- (cadr p2) lg))
rp4 (list (+ (car p2) lg)(+ (cadr p2) lg))
)
(command "._rectangle" rp1 rp2)
(command "._rotate" "_L" "" p1 (rtd ang))
(command "._rectangle" rp3 rp4)
(command "._rotate" "_L" "" p2 (rtd ang))
)
(setvar "osmode" 703)
(setvar "cmdecho" 1)
(princ)
)
(prompt "\n\t\t***\tType BML to draw beam lines\t***")
(princ)
~'J'~
terryh
2007-01-16, 02:03 AM
Could you post a drawing of what you are wanting. It woud help explain it better.
Here is the basic look of what I need. If you notice, I have everything on the same layer. It's how I need it to be, so there's no need to creating additional layers. The positioning of the support notation text should be able to be placed manually (top, bottom, left, right) and come in at 45 degrees. The beam notation text should default to be mid-point 'above' the line (or to the 'left' for the vertical alignment situation). There needs to be a 200mm gap between the grip on the 'box' and the end of the line.
It should work like this...
I click on point A, then point B, a line should appear with a box at each end, then prompt for a beam number input, default locateds it above the midpoint of the line, prompt for point A support number, click the location for this text, then the same for point B support text.
I don't know enough about lisp to know where to start, but I'm sure it can be done.
Thanks.
terryh
2007-01-16, 04:12 AM
Thanks Fixo,
That was close to what I was intending. Here is a similar lisp which draws a stormwater pipe and adds the text centrally on top. I tried modifying this one, but since I have no idea what's what, I got errors all over the place.
(DEFUN C:PIPE ()
; Set Variables
(SETQ C1 (GETVAR "CMDECHO"))
(SETQ B1 (GETVAR "BLIPMODE"))
(SETQ O1 (GETVAR "OSMODE"))
(SETQ SCALE (GETVAR "DIMSCALE"))
(SETVAR "OSMODE" 0)
; Set Constants
(SETQ A90 (/ PI 2))
(SETQ FLAG 0)
(SETQ RADEG (/ 180.0 PI))
; Get the Start and End Points
(SETQ DIAM (GETREAL "\nDRAIN WIDTH <100>: "))
(IF (= DIAM nil) (SETQ DIAM 100.0))
(SETQ W DIAM)
(SETQ W2 (/ W 2))
(SETQ PT1 (GETPOINT "\nEnter Start Point: "))
(SETQ PT2 (GETPOINT PT1 "\nEnter End Point: "))
(SETVAR "CMDECHO" 0)
(SETVAR "BLIPMODE" 0)
; Calculate Distances and Angles
(SETQ D (DISTANCE PT1 PT2))
(SETQ ANG (ANGLE PT1 PT2))
; Draw the Dashes
(COMMAND "LAYER" "M" "SWD-PIPE" "")
(COMMAND "COLOR" "2")
(COMMAND "LINETYPE" "S" "DASHEDX2" "")
(COMMAND "PLINE" PT1 "W" W W PT2 "")
; Draw Outside Lines
(COMMAND "COLOR" "7")
(COMMAND "LINETYPE" "S" "CONTINUOUS" "")
(SETQ PT1A (POLAR PT1 (+ ANG A90) W2))
(SETQ PT1B (POLAR PT1 (- ANG A90) W2))
(SETQ PT2A (POLAR PT2 (+ ANG A90) W2))
(SETQ PT2B (POLAR PT2 (- ANG A90) W2))
(COMMAND "LINE" PT1A PT2A "")
(COMMAND "LINE" PT2B PT1B "")
(COMMAND "COLOR" "7")
;Calculate the output values
(SETQ PTM (POLAR PT1A ANG (/ D 2.0)))
; Check for Correct Text Orientation
(IF (< (CAR PT2) (CAR PT1))
(PROGN
;***************** For DRAINS Drawn Right to Left
; Draw the DRAIN Descriptive Text - WIDTH
(SETQ DG (STRCAT (RTOS W 2 0) " DIA. UPVC 1 IN 100"))
(SETQ PT (POLAR PTM (- ANG A90) (* 1.5 SCALE)))
(COMMAND "TEXT" "C" PT (* SCALE 2.5) (* (+ ANG PI) RADEG) DG)
)
;***************** For DRAINS Drawn Left to Right
(PROGN
; Draw the DRAIN Descriptive Text - WIDTH
(SETQ DG (STRCAT (RTOS W 2 0) " DIA. UPVC 1 IN 100"))
(SETQ PT (POLAR PTM (+ ANG A90) (* 1.5 SCALE)))
(COMMAND "TEXT" "C" PT (* SCALE 2) (* ANG RADEG) DG)
)
)
; Reset Variables
(SETVAR "CMDECHO" C1)
(SETVAR "BLIPMODE" B1)
(SETVAR "OSMODE" O1)
; Exit this Function
(PRIN1)
)[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]
I copied drawing and code you uploaded
Hope I can to do what you want :)
Sorry for the late answer
~'J'~
Give this a try
Let me know if aomething wrong there
; multiple draw beam lines
(defun C:BML (/ errexit undox olderr oldcmdecho
oldosmode oldsnapang ang lg
num p1 p2 pc px rot
rp1 rp2 rp3 rp4
)
;;;error trapping by Jimmy Bergmark
(defun errexit (s)
(princ "\nError: ")
(princ s)
(restore)
)
(defun undox ()
(setvar "osmode" oldosmode)
(setvar "snapang" oldsnapang)
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)
(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setq oldosmode (getvar "osmode"))
(setq oldsnapang (getvar "snapang"))
(command "._UNDO" "_BE")
(setvar "osmode" 0)
(setvar "cmdecho" 0)
;; Convert value in radians to degrees
(defun rtd (a)
(* 180.0 (/ a pi))
)
(setq lg 75.) ;box half size
(while
(setq p1
(getpoint
"\n\tSpecify starting point (or press Enter to stop loop) >>"
)
)
(setq p2 (getpoint p1 "\n\tSpecify ending point >>")
pc (mapcar (function (lambda (a b) (/ (+ a b) 2)))
p1
p2
)
)
(setq lp1 (polar p1 (angle p1 p2) 200.) ; gap
lp2 (polar p2 (angle p2 p1) 200.) ; gap
)
(setq ang (min (angle p1 p2) (angle p2 p1)))
(if (> ang (/ pi 2))
(setq ang (+ ang pi))
)
(command "._line" lp1 lp2 "")
(command "._chprop"
(entlast)
""
"_LT"
"Center"
"_C"
"_Cyan"
""
)
(setq rp1 (list (- (car p1) lg) (- (cadr p1) lg))
rp2 (list (+ (car p1) lg) (+ (cadr p1) lg))
rp3 (list (- (car p2) lg) (- (cadr p2) lg))
rp4 (list (+ (car p2) lg) (+ (cadr p2) lg))
)
(command "._rectangle" rp1 rp2)
(command "._chprop" (entlast) "" "_C" "_White" "")
(command "._rotate" "_L" "" p1 (rtd ang))
(command "._bhatch" "_S" "_L" "" "_P" "_S" "")
(command "._rectangle" rp3 rp4)
(command "._chprop" (entlast) "" "_C" "_White" "")
(command "._rotate" "_L" "" p2 (rtd ang))
(command "._bhatch" "_S" "_L" "" "_P" "_S" "")
(setq num (getstring "\n\tEnter beam number: "))
(setq px (polar pc (+ ang (/ pi 2)) 300.))
(command "._text" "_J" "_MC" px (rtd ang) num)
(command "._chprop" (entlast) "" "_C" "Yellow" "")
(setvar "snapang" (/ pi 4))
(setq
p (getpoint
p1
"\n\tSpecify direction of positioning of notation text : "
)
)
(setq tp1 (polar p1 (angle p1 p) (* 200. (cos (/ pi 4)) 2.75))
tp2 (polar p2 (angle p1 p) (* 200. (cos (/ pi 4)) 2.75))
)
(setq ang (min (angle p1 p) (angle p p1)))
(if (> ang (/ pi 2))
(setq ang (+ ang pi))
)
(setq mk1 (getstring
"\n\tStarting annotation (or press Enter to default) <C1> : "
)
mk2 (getstring
"\n\tEnding annotation (or press Enter to default)<C2> : "
)
)
(if (eq "" mk1)
(setq mk1 "C1")
)
(if (eq "" mk2)
(setq mk2 "C2")
)
(command "._text" "_J" "_MC" tp1 (rtd ang) mk1)
(command "._chprop" (entlast) "" "_C" "_White" "")
(command "._text" "_J" "_MC" tp2 (rtd ang) mk2)
(command "._chprop" (entlast) "" "_C" "_White" "")
(setvar "snapang" 0)
)
(restore)
(princ)
)
(prompt "\n\t\t***\tType BML to draw beam lines\t***")
(princ)
~'J'~
terryh
2007-01-17, 03:35 AM
fixo you're a champion. That's pretty much what I wanted. I tweaked a few lines here and there and got it to do what I wanted on LT2004 & LT2006.
I changed the box size to be 120 square. I also renamed the lisp to BM.lsp and changed the default C1 & C2 support notations to both be DS1.
Question: How do you restore the osnaps once the command is exited?
Also, I've tried a few things myself with no luck, but I need the text on the beam to be fixed at 300 high, Yellow, Romans.shx, and the support text to be 200 high, White, Romans.shx???? I changed the text style to our standard styles as they scale according to the current dimscale, but then they get messed up when I change the dimscale to draw details, etc.
Thanks a lot for your help.
; multiple draw beam lines
(defun C:BM (/ errexit undox olderr oldcmdecho
oldosmode oldsnapang ang lg
num p1 p2 pc px rot
rp1 rp2 rp3 rp4
)
;;;error trapping by Jimmy Bergmark
(defun errexit (s)
(princ "\nError: ")
(princ s)
(restore)
)
(defun undox ()
(setvar "osmode" oldosmode)
(setvar "snapang" oldsnapang)
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)
(setq olderr *error*
restore undox
*error* errexit
)
(setq oldcmdecho (getvar "cmdecho"))
(setq oldosmode (getvar "osmode"))
(setq oldsnapang (getvar "snapang"))
(command "._UNDO" "_BE")
(setvar "osmode" 0)
(setvar "cmdecho" 0)
;; Convert value in radians to degrees
(defun rtd (a)
(* 180.0 (/ a pi))
)
(setq lg 60.) ;box half size
(while
(setq p1
(getpoint
"\n\tSpecify starting point (or press Enter to stop loop) >>"
)
)
(setq p2 (getpoint p1 "\n\tSpecify ending point >>")
pc (mapcar (function (lambda (a b) (/ (+ a b) 2)))
p1
p2
)
)
(setq lp1 (polar p1 (angle p1 p2) 200.) ; gap
lp2 (polar p2 (angle p2 p1) 200.) ; gap
)
(setq ang (min (angle p1 p2) (angle p2 p1)))
(if (> ang (/ pi 2))
(setq ang (+ ang pi))
)
(command "._line" lp1 lp2 "")
(command "._chprop"
(entlast)
""
"_LT"
"Center"
"_C"
"_Cyan"
""
)
(setq rp1 (list (- (car p1) lg) (- (cadr p1) lg))
rp2 (list (+ (car p1) lg) (+ (cadr p1) lg))
rp3 (list (- (car p2) lg) (- (cadr p2) lg))
rp4 (list (+ (car p2) lg) (+ (cadr p2) lg))
)
(command "._rectangle" rp1 rp2)
(command "._chprop" (entlast) "" "_C" "_White" "")
(command "._rotate" "_L" "" p1 (rtd ang))
(command "._bhatch" "_S" "_L" "" "_P" "_S" "")
(command "._rectangle" rp3 rp4)
(command "._chprop" (entlast) "" "_C" "_White" "")
(command "._rotate" "_L" "" p2 (rtd ang))
(command "._bhatch" "_S" "_L" "" "_P" "_S" "")
(setq num (getstring "\n\tEnter beam number: "))
(setq px (polar pc (+ ang (/ pi 2)) 300.))
(command "._text" "_S" "FMG-300" "_J" "_MC" px (rtd ang) num)
(command "._chprop" (entlast) "" "_C" "Yellow" "")
(setvar "snapang" (/ pi 4))
(setq
p (getpoint
p1
"\n\tSpecify direction of positioning of notation text : "
)
)
(setq tp1 (polar p1 (angle p1 p) (* 200. (cos (/ pi 4)) 2.75))
tp2 (polar p2 (angle p1 p) (* 200. (cos (/ pi 4)) 2.75))
)
(setq ang (min (angle p1 p) (angle p p1)))
(if (> ang (/ pi 2))
(setq ang (+ ang pi))
)
(setq mk1 (getstring
"\n\tStarting annotation (or press Enter to default) <DS1> : "
)
mk2 (getstring
"\n\tEnding annotation (or press Enter to default)<DS1> : "
)
)
(if (eq "" mk1)
(setq mk1 "DS1")
)
(if (eq "" mk2)
(setq mk2 "DS1")
)
(command "._text" "_S" "FMG-200" "_J" "_MC" tp1 (rtd ang) mk1)
(command "._chprop" (entlast) "" "_C" "_White" "")
(command "._text" "_J" "_MC" tp2 (rtd ang) mk2)
(command "._chprop" (entlast) "" "_C" "_White" "")
(setvar "snapang" 0)
)
(restore)
(princ)
)
(prompt "\n\t\t***\tType BM to draw beam lines\t***")
(princ)
Taa much, Terry :)
Sorry for the late answer
I will be busy today with my own problem,
but maybe I'll can to varnish this routine to your
needs also
See you later,
~'J'~
Hi Terry,
here is edited version
Let me know if I've missed up there
See comments inside the code
Hth
; multiple draw beam lines
(defun C:BM (/ errexit undox olderr oldcmdecho oldlayer
oldosmode oldsnapang ang lg
num p1 p2 pc px rot
rp1 rp2 rp3 rp4
)
;;;error trapping by Jimmy Bergmark
(defun errexit (s)
(princ "\nError: ")
(princ s)
(restore)
)
(defun undox ()
(setvar "osmode" oldosmode)
(setvar "snapang" oldsnapang)
(setvar "clayer" oldlayer)
(command "._undo" "_E")
(setvar "cmdecho" oldcmdecho)
(setq *error* olderr)
(princ)
)
(setq olderr *error*
restore undox
*error* errexit
)
(setq oldlayer (getvar "clayer"))
(setq oldcmdecho (getvar "cmdecho"))
(setq oldosmode (getvar "osmode"))
(setq oldsnapang (getvar "snapang"))
(command "._UNDO" "_BE")
(setvar "osmode" 0)
(setvar "cmdecho" 0)
;; *** Convert value in radians to degrees ***
(defun rtd (a)
(* 180.0 (/ a pi))
)
;; *** 'entmake' text ***
(defun entmaketext
(value style height inspoint rot layer color dxf71 dxf72 dxf73)
(entmake
(list
(cons 0 "TEXT")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 1 value)
(cons 7 style)
(cons 8 layer)
(cons 62 color)
(cons 10 inspoint)
(cons 11 inspoint)
(cons 40 height)
(cons 50 rot)
(cons 71 dxf71)
(cons 72 dxf72)
(cons 73 dxf73)
)
)
)
;; *** load linetype if this does not exist ***
(if (not (tblsearch "ltype" "Center"))
(progn
(setvar "expert" 3)
(command "._-linetype" "load" "Center" "" "")
(setvar "expert" 0)
)
)
;; *** make layer "-FMG" if this does not exist ***
(if (not (tblsearch "layer" "-FMG"))
(command "layer" "make" "-FMG" "color" "cyan"
"-FMG" "ltype" "Continuous" "" "")
)
(setvar "clayer" "-FMG")
;; *** 'entmake' text style "Terry" if this does not exist ***
(if (not (tblsearch "STYLE" "FMG-STD"))
(entmake '((0 . "STYLE")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "FMG-STD") ; style name, change to standards
(70 . 0)
(40 . 0.0) ; not fixed text height
(41 . 1.0)
(50 . 0.0)
(71 . 0)
(42 . 300.0) ; last text height used
(3 . "ROMANS.SHX")
(4 . "") ; bigfont file name; blank if none
)
)
)
;|dxf codes for ML and MC text alignment:
|-------|---|---|
| Code | ML| MC|
|-------|---|---|
| dxf71 | 0 | 0 | text generation (optional = 0)
| dxf72 | 0 | 1 | horizontal alignment
| dxf73 | 2 | 2 | vertical alignment
|-------|---|---|
|;
(setq lg 60.) ;box half size
(while
(setq p1
(getpoint
"\n\tSpecify starting point (or press Enter to stop loop) >>"
)
)
(setq p2 (getpoint p1 "\n\tSpecify ending point >>")
pc (mapcar (function (lambda (a b) (/ (+ a b) 2)))
p1
p2
)
)
(setq lp1 (polar p1 (angle p1 p2) 200.) ; gap
lp2 (polar p2 (angle p2 p1) 200.) ; gap
)
(setq ang (min (angle p1 p2) (angle p2 p1)))
(if (> ang (/ pi 2))
(setq ang (+ ang pi))
)
(command "._line" lp1 lp2 "")
(command "._chprop"
(entlast)
""
"_LT"
"Center"
"_C"
"_Cyan"
""
)
(setq rp1 (list (- (car p1) lg) (- (cadr p1) lg))
rp2 (list (+ (car p1) lg) (+ (cadr p1) lg))
rp3 (list (- (car p2) lg) (- (cadr p2) lg))
rp4 (list (+ (car p2) lg) (+ (cadr p2) lg))
)
(command "._rectangle" rp1 rp2)
(command "._chprop" (entlast) "" "_C" "_White" "")
(command "._rotate" "_L" "" p1 (rtd ang))
(command "._bhatch" "_S" "_L" "" "_P" "_S" "")
(command "._rectangle" rp3 rp4)
(command "._chprop" (entlast) "" "_C" "_White" "")
(command "._rotate" "_L" "" p2 (rtd ang))
(command "._bhatch" "_S" "_L" "" "_P" "_S" "")
(setq num (getstring "\n\tEnter beam number: "))
(setq px (polar pc (+ ang (/ pi 2)) 350.0))
(entmaketext num "FMG-STD" 300. px ang "-FMG" 2 0 1 2)
(setvar "snapang" (/ pi 4))
(setq
p (getpoint
p1
"\n\tSpecify direction of positioning of notation text : "
)
)
(setq ang (min (angle p1 p) (angle p p1)))
(if (> ang (/ pi 2))
(setq ang (+ ang pi))
)
(setq mk1 (getstring
"\n\tStarting annotation (or press Enter to default) <DS1> : "
)
mk2 (getstring
"\n\tEnding annotation (or press Enter to default)<DS2> : "
)
)
(if (eq "" mk1)
(setq mk1 "DS1")
)
(if (eq "" mk2)
(setq mk2 "DS2")
)
(setq tp1 (polar p1 (angle p1 p) (* (cos (/ pi 4)) (strlen mk1)(/ 200. (cos (/ pi 4)))))
tp2 (polar p2 (angle p1 p) (* (cos (/ pi 4)) (strlen mk2)(/ 200. (cos (/ pi 4)))))
)
(entmaketext
mk1 ; text string
"FMG-STD"; text style
200. ;text height
tp1 ; insertion point
ang ; rotation angle
"-FMG" ; layer
7 ; color
0 ; text generation flag must be ommitted (optional = 0)
1 ; horizontal text alignment flag
2 ; vertical text alignment flag
)
(entmaketext mk2 "FMG-STD" 200. tp2 ang "-FMG" 7 0 1 2)
(setvar "snapang" 0)
)
(restore)
(princ)
)
(prompt "\n\t\t***\tType BM to draw beam lines\t***")
(princ)
One semicolon was lost, sorry
~'J'~
terryh
2007-01-17, 10:19 PM
You did it. Thanks so much for your effort. You've just saved our company quite a bit of time with this handy little lisp. It's exactly how I wanted it to be, and you've helped me out like a champion. I hope I didn't inconvenience you with this one. Now I've gotta do a course on lisp so I can work this stuff out myself.
Have a great day mate!
Thanks again, Terry :)
Glad if this helps
Knock my door if you need some
help again
Happy computing
~'J'~
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.