Stryder Posted April 14, 2009 Author Posted April 14, 2009 SWEET!!! I am having one problem though, when the mtext that has the width of 90 is placed the offset from the line has varied from one drawing to the next? Not sure what caused this, let me know what you think? Thanks, Stryder Quote
Lee Mac Posted April 14, 2009 Posted April 14, 2009 SWEET!!! I am having one problem though, when the mtext that has the width of 90 is placed the offset from the line has varied from one drawing to the next? Not sure what caused this, let me know what you think? Thanks, Stryder The size of the textbox, and consequently the rotation and movement is determined by the variable TLINESPAC multiplied by the variable TEXTSIZE, this may vary from drawing to drawing... Quote
Stryder Posted April 14, 2009 Author Posted April 14, 2009 hmmm.... Is there a way to make this to where it is constant just like the mtext without a width? If not I guess I will just stick to the previous code. Quote
Lee Mac Posted April 14, 2009 Posted April 14, 2009 Hmm... try this, but I don't like it too much ;; Pipe Text Marker by Lee McDonnell 13.04.2009 (defun c:pipetxt (/ *error* vlst ovar doc spc scl diam manhol lEnt lObj lLen lSpt lEpt lAng lMid tStr tBox tHgt tWid gr#drag Dr#pt cPt cLen cAng lMid# blpt# brpt# lMidt# tlpt# trpt# @tplft @botcen VecLen VecAng Mtxt mVec flag) (vl-load-com) (defun *error* (msg) (if ovar (mapcar 'setvar vlst ovar)) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " (strcase msg))) (princ "\n<-- cancelled -->")) (redraw) (princ)) (setq vlst '("CLAYER" "OSMODE" "DIMZIN") ovar (mapcar 'getvar vlst)) (mapcar 'setvar (cdr vlst) '(0 1)) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or (tblsearch "LAYER" "TXT-100") (vla-add (vla-get-layers doc) "TXT-100")) (or (and (zerop (getvar "DIMSCALE")) (setq scl 1.0)) (setq scl (getvar "DIMSCALE"))) (or pip:dia (setq pip:dia ) (or man:hol (setq man:hol 10.96)) (or pipe:tOff (setq pipe:tOff 4.0)) (initget 6) (setq diam (getreal (strcat "\nSpecify Diameter of Pipeline <" (rtos pip:dia 2 0) "\">: "))) (or (not diam) (setq pip:dia diam)) (initget 6) (setq manhol (getreal (strcat "\nSpecify Manhole Diameter <" (rtos man:hol 2 2) "'>: "))) (or (not manhol) (setq man:hol manhol)) (initget 6) (setq tOff (getreal (strcat "\nSpecify Text Offset <" (rtos pipe:tOff 2 2) ">: "))) (or (not tOff) (setq pipe:tOff tOff)) (while (and (setq lEnt (car (entsel "\nSelect Pipeline: "))) (eq "LINE" (cdadr (entget lEnt)))) (setq lObj (vlax-ename->vla-object lEnt) lSpt (vlax-curve-getStartPoint lObj) lEpt (vlax-curve-getEndPoint lObj) lAng (angle lSpt lEpt) xdis (- (car lEpt) (car lSpt))) (if (zerop xdis) (setq lSlp "-") (setq lSlp (rtos (/ (- (cadr lEpt) (cadr lSpt)) (* 10.0 xdis)) 2 3))) (setq lLen (+ (abs (- (car lEpt) (car lSpt))) man:hol) lMid (vlax-curve-getPointatParam lObj (/ (vlax-curve-getEndParam lObj) 2.0))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq tStr (strcat (rtos lLen 2 0) " L.F. OF " (rtos pip:dia 2 0) "\"%%C P.V.C. @ " lSlp " SLOPE") tBox (textbox (list (cons 1 (strcat (chr 32) tStr (chr 32))) (cons 40 (* scl 0.1))))) (if (<= lLen 165.0) (setq tBox (list (car tBox) (list (+ 90.0 (caar tBox)) 14.29))) nil) (setq tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox))) (princ "\n<< Enter to Accept >> Hit Shift to Alter Position: ") (while (and (not flag) (/= 2 (car (setq gr#drag (grread t 7 0)))) (/= 13 (cadr gr#drag))) (redraw) (setq cAng (+ lAng (/ pi 2)) lMid# (polar lMid cAng pipe:tOff) blpt# (polar lMid# (+ cAng (/ pi 2)) (/ tWid 2.0)) brpt# (polar lMid# (- cAng (/ pi 2)) (/ tWid 2.0)) lMidt# (polar lMid# cAng tHgt) tlpt# (polar lMidt# (+ cAng (/ pi 2)) (/ tWid 2.0)) trpt# (polar lMidt# (- cAng (/ pi 2)) (/ tWid 2.0))) (grvecs (list 3 blpt# brpt# 3 blpt# tlpt# 3 brpt# trpt# 3 tlpt# trpt#)) (if (acet-sys-shift-down) (progn (while (/= 3 (car (setq gr#drag (grread t 7 0)))) (redraw) (if (listp (setq Dr#pt (cadr gr#drag))) (progn (setq cPt (vlax-curve-getClosestPointto lObj Dr#pt) cLen (distance cPt Dr#pt) cAng (+ lAng (/ pi 2)) lMid# (polar lMid cAng cLen) blpt# (polar lMid# (+ cAng (/ pi 2)) (/ tWid 2.0)) brpt# (polar lMid# (- cAng (/ pi 2)) (/ tWid 2.0)) lMidt# (polar lMid# cAng tHgt) tlpt# (polar lMidt# (+ cAng (/ pi 2)) (/ tWid 2.0)) trpt# (polar lMidt# (- cAng (/ pi 2)) (/ tWid 2.0))) (grvecs (list 3 blpt# brpt# 3 blpt# tlpt# 3 brpt# trpt# 3 tlpt# trpt#))))) (setq flag T)))) (setq @tplft (list (caar tBox) (cadadr tBox)) @btcen (list (+ (caar tBox) (/ tWid 2.0)) (cadar tBox)) VecLen (distance @tplft @btcen) VecAng (+ lAng (angle @btcen @tplft)) Mtxt (vla-addMText spc (vlax-3D-point lMid#) tWid tStr)) (vla-put-height Mtxt (* 0.1 scl)) (vla-put-rotation Mtxt lAng) (if (<= lLen 165.0) (vla-put-width Mtxt 90) (vla-put-width Mtxt 0)) (vla-move Mtxt (vlax-3D-point '(0 0 0)) (vlax-3D-point (polar '(0 0 0) VecAng VecLen))) (vla-put-AttachmentPoint Mtxt acAttachmentPointBottomCenter) (vla-put-layer Mtxt "TXT-100") (vla-put-StyleName Mtxt (getvar "TEXTSTYLE")) (redraw) (setq flag nil)) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) Quote
Stryder Posted April 14, 2009 Author Posted April 14, 2009 Why don't you like it? Strange things are happening when I use it. The distance from the line to the insertion point of the text is different for the mtext with a width than from the mtext with the width of 0. And the distance varies from drawing to drawing. Maybe in this case I am guilty of wanting a lazy-man's customization to a lisp that is AWESOME to begin with. All I have to do is click the mtext and then in properties type 90 for the width if I want it stacked, I just sort of thought you could show off some of your AMAZING skillz if it would do this automatically for us! Thanks for the help, Stryder P.S. - Keep this up and I may get you on the payroll here!:wink: Quote
uddfl Posted April 14, 2009 Posted April 14, 2009 Thanks for the help,Stryder P.S. - Keep this up and I may get you on the payroll here!:wink: Now that would be a way of giving thanks for help. Quote
Lee Mac Posted April 14, 2009 Posted April 14, 2009 Why don't you like it? Just because I modelled it on the drawing that you posted and just measured the height of two rows of text and used that as the measurement, so it will be different for different Text Styles, Sizes etc. - I shall have another look though P.S. - Keep this up and I may get you on the payroll here!:wink: Now that would be a treat Quote
Lee Mac Posted April 14, 2009 Posted April 14, 2009 Give this a shot - if this doesn't work then I am fast running out of ideas... ;; Pipe Text Marker by Lee McDonnell 13.04.2009 (defun c:pipetxt (/ *error* vlst ovar doc spc scl diam manhol lEnt lObj lLen lSpt lEpt lAng lMid tStr tBox tHgt tWid gr#drag Dr#pt cPt cLen cAng lMid# blpt# brpt# lMidt# tlpt# trpt# @tplft @botcen VecLen VecAng Mtxt mVec flag) (vl-load-com) (defun *error* (msg) (if ovar (mapcar 'setvar vlst ovar)) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " (strcase msg))) (princ "\n<-- cancelled -->")) (redraw) (princ)) (setq vlst '("CLAYER" "OSMODE" "DIMZIN") ovar (mapcar 'getvar vlst)) (mapcar 'setvar (cdr vlst) '(0 1)) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or (tblsearch "LAYER" "TXT-100") (vla-add (vla-get-layers doc) "TXT-100")) (or (and (zerop (getvar "DIMSCALE")) (setq scl 1.0)) (setq scl (getvar "DIMSCALE"))) (or pip:dia (setq pip:dia ) (or man:hol (setq man:hol 10.96)) (or pipe:tOff (setq pipe:tOff 4.0)) (initget 6) (setq diam (getreal (strcat "\nSpecify Diameter of Pipeline <" (rtos pip:dia 2 0) "\">: "))) (or (not diam) (setq pip:dia diam)) (initget 6) (setq manhol (getreal (strcat "\nSpecify Manhole Diameter <" (rtos man:hol 2 2) "'>: "))) (or (not manhol) (setq man:hol manhol)) (initget 6) (setq tOff (getreal (strcat "\nSpecify Text Offset <" (rtos pipe:tOff 2 2) ">: "))) (or (not tOff) (setq pipe:tOff tOff)) (while (and (setq lEnt (car (entsel "\nSelect Pipeline: "))) (eq "LINE" (cdadr (entget lEnt)))) (setq lObj (vlax-ename->vla-object lEnt) lSpt (vlax-curve-getStartPoint lObj) lEpt (vlax-curve-getEndPoint lObj) lAng (angle lSpt lEpt) xdis (- (car lEpt) (car lSpt))) (if (zerop xdis) (setq lSlp "-") (setq lSlp (rtos (/ (- (cadr lEpt) (cadr lSpt)) (* 10.0 xdis)) 2 3))) (setq lLen (+ (abs (- (car lEpt) (car lSpt))) man:hol) lMid (vlax-curve-getPointatParam lObj (/ (vlax-curve-getEndParam lObj) 2.0))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq tStr (strcat (rtos lLen 2 0) " L.F. OF " (rtos pip:dia 2 0) "\"%%C P.V.C. @ " lSlp " SLOPE") tBox (textbox (list (cons 1 (strcat (chr 32) tStr (chr 32))) (cons 40 (* scl 0.1))))) (if (<= lLen 165.0) (setq tBox (list (car tBox) (list (+ 90.0 (caar tBox)) (+ (* (getvar 'TSPACEFAC) (getvar 'TEXTSIZE) 1.66) (cadadr tBox))))) nil) (setq tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox))) (princ "\n<< Enter to Accept >> Hit Shift to Alter Position: ") (while (and (not flag) (/= 2 (car (setq gr#drag (grread t 7 0)))) (/= 13 (cadr gr#drag))) (redraw) (setq cAng (+ lAng (/ pi 2)) lMid# (polar lMid cAng pipe:tOff) blpt# (polar lMid# (+ cAng (/ pi 2)) (/ tWid 2.0)) brpt# (polar lMid# (- cAng (/ pi 2)) (/ tWid 2.0)) lMidt# (polar lMid# cAng tHgt) tlpt# (polar lMidt# (+ cAng (/ pi 2)) (/ tWid 2.0)) trpt# (polar lMidt# (- cAng (/ pi 2)) (/ tWid 2.0))) (grvecs (list 3 blpt# brpt# 3 blpt# tlpt# 3 brpt# trpt# 3 tlpt# trpt#)) (if (acet-sys-shift-down) (progn (while (/= 3 (car (setq gr#drag (grread t 7 0)))) (redraw) (if (listp (setq Dr#pt (cadr gr#drag))) (progn (setq cPt (vlax-curve-getClosestPointto lObj Dr#pt) cLen (distance cPt Dr#pt) cAng (+ lAng (/ pi 2)) lMid# (polar lMid cAng cLen) blpt# (polar lMid# (+ cAng (/ pi 2)) (/ tWid 2.0)) brpt# (polar lMid# (- cAng (/ pi 2)) (/ tWid 2.0)) lMidt# (polar lMid# cAng tHgt) tlpt# (polar lMidt# (+ cAng (/ pi 2)) (/ tWid 2.0)) trpt# (polar lMidt# (- cAng (/ pi 2)) (/ tWid 2.0))) (grvecs (list 3 blpt# brpt# 3 blpt# tlpt# 3 brpt# trpt# 3 tlpt# trpt#))))) (setq flag T)))) (setq @tplft (list (caar tBox) (cadadr tBox)) @btcen (list (+ (caar tBox) (/ tWid 2.0)) (cadar tBox)) VecLen (distance @tplft @btcen) VecAng (+ lAng (angle @btcen @tplft)) Mtxt (vla-addMText spc (vlax-3D-point lMid#) tWid tStr)) (vla-put-height Mtxt (* 0.1 scl)) (vla-put-rotation Mtxt lAng) (vla-put-width Mtxt 0) (vla-move Mtxt (vlax-3D-point '(0 0 0)) (vlax-3D-point (polar '(0 0 0) VecAng VecLen))) (if (<= lLen 165.0) (vla-put-width Mtxt 90)) (vla-put-AttachmentPoint Mtxt acAttachmentPointBottomCenter) (vla-put-layer Mtxt "TXT-100") (vla-put-StyleName Mtxt (getvar "TEXTSTYLE")) (redraw) (setq flag nil)) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) Quote
Stryder Posted April 14, 2009 Author Posted April 14, 2009 Awesome!!! It is not exactly 4 every time but it is close enough. I am not building a piano or performing spinal sugery here. Thanks so much for the help, Stryder P.S. I will post my new project tomorrow or maybe in about an hour. Quote
Lee Mac Posted April 14, 2009 Posted April 14, 2009 Awesome!!! It is not exactly 4 every time but it is close enough. I am not building a piano or performing spinal sugery here. Thanks so much for the help, Stryder P.S. I will post my new project tomorrow or maybe in about an hour. Excellent, glad that its nearer the mark Look forward to working with you again. Cheers, Lee Quote
NH3man! Posted April 14, 2009 Posted April 14, 2009 I watch you Lee in amazement! Your an extraordinary benefit to this community. I applaud you for all you efforts! NH3man! Quote
Lee Mac Posted April 15, 2009 Posted April 15, 2009 I watch you Lee in amazement! Your an extraordinary benefit to this community. I applaud you for all you efforts! NH3man! Thanks NH3man I try my best - but I hope that people do learn from the routines, and try to learn LISP and Visual LISP themselves, and not just take the routines as they "do the job". Lee Quote
Stryder Posted April 15, 2009 Author Posted April 15, 2009 Well, yesterday I had this working perfectly. I go home and come back in to work this morning and try to use the lisp and it is back to placing the text below the line if the width is changed to 90. The single line with a 0 width works fine. If you want to mess with it, that is fine, but I think we can just go back to the mtext with a width of 0 and change it manually to 90 when we need to. Thanks NH3man I try my best - but I hope that people do learn from the routines, and try to learn LISP and Visual LISP themselves, and not just take the routines as they "do the job". Lee It has worked with me, you have inspired me to learn LISP. It would be a HUGE advantage to be able to write this stuff myself. Thanks, Stryder Quote
Lee Mac Posted April 15, 2009 Posted April 15, 2009 Well, yesterday I had this working perfectly. I go home and come back in to work this morning and try to use the lisp and it is back to placing the text below the line if the width is changed to 90. The single line with a 0 width works fine. If you want to mess with it, that is fine, but I think we can just go back to the mtext with a width of 0 and change it manually to 90 when we need to. I can't seem to replicate this Using the latest posted code - see attached video (on the drawing you posted for me). It has worked with me, you have inspired me to learn LISP. It would be a HUGE advantage to be able to write this stuff myself. You can learn a lot from the tutorials posted on this site, or just a simple google search will bring loads of info. But, tbh, I find that the easiest way to learn things (once you have a basic knowledge), is from the code people post on here (make sure you have a reliable source! - some code posted on here is erroneous... and I don't exclude myself..). Lee Pipetxt.zip Quote
Stryder Posted April 15, 2009 Author Posted April 15, 2009 Well, I went back to the code you pasted in post #44. The one you said that you didn't like. It works fine now. I have a feeling that it has something to do with the 2008 version of AutoCAD screwing with me. I have experienced settings changing for other things since using 2008. I don't understand, and maybe you can explain, why would the placement of the mtext be different for single line with a width of 0 than it is for the mtext that is wrapping with a width of 90? Sweet video, what did you use to make it? Quote
Lee Mac Posted April 15, 2009 Posted April 15, 2009 Well, I went back to the code you pasted in post #44. The one you said that you didn't like. It works fine now. I have a feeling that it has something to do with the 2008 version of AutoCAD screwing with me. I have experienced settings changing for other things since using 2008. I don't understand, and maybe you can explain, why would the placement of the mtext be different for single line with a width of 0 than it is for the mtext that is wrapping with a width of 90? Ok, here goes nothing.... Lets assume that there is no offset and you want the text to be placed with the bottom-center point at the midpoint of the line - this will simplify our situation. So, I first place the text. The insertion point of the MTEXT is always recognised by LISP as being the top-left-hand corner of the MTEXT, so the text is initially placed like this: I then proceed to put the angle of the line as the rotation of the MTEXT, but this will rotate the MTEXT about the insertion point, so that it looks like this: I now need to move the MTEXT so that the bottom center point is at the mid-point of the line (with our aforementioned assumption). To do this, I find the vector that runs from the top-left-hand corner to the bottom mid point. This vector will vary with Text Size, Text Style, Rotation, and the value of the String itself. I then move the text with a base point of the origin, by a displacement of this vector: Hope this makes more sense. You can now see why it is more difficult to put in two lines of text. - to find the vector I use a function called "TEXTBOX" which gives the bottom-right and upper-left coordinates of the bounding box of the text, if it were to be inserted at the origin - but this does not allow for two lines of text, as line spacing now needs to be accounted for - which also varies from drawing to drawing and text style to text style - this complicates matters further. Sweet video, what did you use to make it? I use Windows Media Encoder - a free bit of software - just search for it on the Microsoft Site. I shall have one more attempt at positioning the two-lines of MTEXT, but I can't quite understand why it would be below the line in some cases... Hope this makes things clearer. Cheers Lee Quote
Stryder Posted April 15, 2009 Author Posted April 15, 2009 VERY NICE!!! Excellent job of explaining how you get this to work. I think I may be able to help too. This may change the way the lisp works, especially with the shift to manually place the text. What if you place the text as if it were the single line and then change the properties of the text to have a width of 90. Then you would already have the exact location. Also, when using shift to place the text manually, all I need to see is the bottom of the box; if that makes it easier. Thanks, Stryder Quote
Lee Mac Posted April 15, 2009 Posted April 15, 2009 VERY NICE!!! Excellent job of explaining how you get this to work. I think I may be able to help too. This may change the way the lisp works, especially with the shift to manually place the text. What if you place the text as if it were the single line and then change the properties of the text to have a width of 90. Then you would already have the exact location. Also, when using shift to place the text manually, all I need to see is the bottom of the box; if that makes it easier. Thanks, Stryder Nice idea, but already experimented with that - when the text is made into two lines, the bottom line would overhang the line as the insertion point is fixed. Quote
Stryder Posted April 15, 2009 Author Posted April 15, 2009 DANG!!! That isn't the way it works when I change it in AutoCAD. I am sure that LISP treats it differently. In AutoCAD I use the code you wrote that has the mtext with a width of 0 and then select the text go to properties and change the width to 90. Since the text is already BC justification it keeps that point and then stacks the text above. Oh well, it was worth a shot. Quote
Lee Mac Posted April 15, 2009 Posted April 15, 2009 Not sure if this will perform any better: ;; Pipe Text Marker by Lee McDonnell 13.04.2009 (defun c:pipetxt (/ *error* vlst ovar doc spc scl diam manhol lEnt lObj lLen lSpt lEpt lAng lMid tStr tBox tHgt tWid gr#drag Dr#pt cPt cLen cAng lMid# blpt# brpt# lMidt# tlpt# trpt# @tplft @botcen VecLen VecAng Mtxt mVec flag) (vl-load-com) (defun *error* (msg) (if ovar (mapcar 'setvar vlst ovar)) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " (strcase msg))) (princ "\n<-- cancelled -->")) (redraw) (princ)) (setq vlst '("CLAYER" "OSMODE" "DIMZIN") ovar (mapcar 'getvar vlst)) (mapcar 'setvar (cdr vlst) '(0 1)) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or (tblsearch "LAYER" "TXT-100") (vla-add (vla-get-layers doc) "TXT-100")) (or (and (zerop (getvar "DIMSCALE")) (setq scl 1.0)) (setq scl (getvar "DIMSCALE"))) (or pip:dia (setq pip:dia ) (or man:hol (setq man:hol 10.96)) (or pipe:tOff (setq pipe:tOff 4.0)) (initget 6) (setq diam (getreal (strcat "\nSpecify Diameter of Pipeline <" (rtos pip:dia 2 0) "\">: "))) (or (not diam) (setq pip:dia diam)) (initget 6) (setq manhol (getreal (strcat "\nSpecify Manhole Diameter <" (rtos man:hol 2 2) "'>: "))) (or (not manhol) (setq man:hol manhol)) (initget 6) (setq tOff (getreal (strcat "\nSpecify Text Offset <" (rtos pipe:tOff 2 2) ">: "))) (or (not tOff) (setq pipe:tOff tOff)) (while (and (setq lEnt (car (entsel "\nSelect Pipeline: "))) (eq "LINE" (cdadr (entget lEnt)))) (setq lObj (vlax-ename->vla-object lEnt) lSpt (vlax-curve-getStartPoint lObj) lEpt (vlax-curve-getEndPoint lObj) lAng (angle lSpt lEpt) xdis (- (car lEpt) (car lSpt))) (if (zerop xdis) (setq lSlp "-") (setq lSlp (rtos (/ (- (cadr lEpt) (cadr lSpt)) (* 10.0 xdis)) 2 3))) (setq lLen (+ (abs (- (car lEpt) (car lSpt))) man:hol) lMid (vlax-curve-getPointatParam lObj (/ (vlax-curve-getEndParam lObj) 2.0))) (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq tStr (strcat (rtos lLen 2 0) " L.F. OF " (rtos pip:dia 2 0) "\"%%C P.V.C. @ " lSlp " SLOPE") tBox (textbox (list (cons 1 tStr) (cons 40 (* scl 0.1))))) (if (<= lLen 165.0) (setq tBox (list (car tBox) (list (+ 90.0 (caar tBox)) (+ (* (getvar 'TSPACEFAC) (getvar 'TEXTSIZE) 1.66) (cadadr tBox))))) nil) (setq tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox))) (princ "\n<< Enter to Accept >> Hit Shift to Alter Position: ") (while (and (not flag) (/= 2 (car (setq gr#drag (grread t 7 0)))) (/= 13 (cadr gr#drag))) (redraw) (setq cAng (+ lAng (/ pi 2)) lMid# (polar lMid cAng pipe:tOff) blpt# (polar lMid# (+ cAng (/ pi 2)) (/ tWid 2.0)) brpt# (polar lMid# (- cAng (/ pi 2)) (/ tWid 2.0)) lMidt# (polar lMid# cAng tHgt) tlpt# (polar lMidt# (+ cAng (/ pi 2)) (/ tWid 2.0)) trpt# (polar lMidt# (- cAng (/ pi 2)) (/ tWid 2.0))) (grvecs (list 3 blpt# brpt# 3 blpt# tlpt# 3 brpt# trpt# 3 tlpt# trpt#)) (if (acet-sys-shift-down) (progn (while (/= 3 (car (setq gr#drag (grread t 7 0)))) (redraw) (if (listp (setq Dr#pt (cadr gr#drag))) (progn (setq cPt (vlax-curve-getClosestPointto lObj Dr#pt) cLen (distance cPt Dr#pt) cAng (+ lAng (/ pi 2)) lMid# (polar lMid cAng cLen) blpt# (polar lMid# (+ cAng (/ pi 2)) (/ tWid 2.0)) brpt# (polar lMid# (- cAng (/ pi 2)) (/ tWid 2.0)) lMidt# (polar lMid# cAng tHgt) tlpt# (polar lMidt# (+ cAng (/ pi 2)) (/ tWid 2.0)) trpt# (polar lMidt# (- cAng (/ pi 2)) (/ tWid 2.0))) (grvecs (list 3 blpt# brpt# 3 blpt# tlpt# 3 brpt# trpt# 3 tlpt# trpt#))))) (setq flag T)))) (setq @tplft (list (caar tBox) (cadadr tBox)) @btcen (list (+ (caar tBox) (/ tWid 2.0)) (cadar tBox)) VecLen (distance @tplft @btcen) VecAng (+ lAng (angle @btcen @tplft)) Mtxt (vla-addMText spc (vlax-3D-point lMid#) tWid tStr)) (vla-put-height Mtxt (* 0.1 scl)) (vla-put-rotation Mtxt lAng) (vla-put-width Mtxt 0) (vla-move Mtxt (vlax-3D-point '(0 0 0)) (vlax-3D-point (polar '(0 0 0) VecAng VecLen))) (if (<= lLen 165.0) (vla-put-width Mtxt 90)) (vla-put-AttachmentPoint Mtxt acAttachmentPointBottomCenter) (vla-put-layer Mtxt "TXT-100") (vla-put-StyleName Mtxt (getvar "TEXTSTYLE")) (redraw) (setq flag nil)) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.