Lee Mac Posted April 10, 2009 Share Posted April 10, 2009 I think that is definitely possible - I shall get on to it tomorrow Cheers Lee Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 10, 2009 Share Posted April 10, 2009 Hi Stryder - hopefully this will suit your needs (defun c:pipetxt (/ *error* vlst ovar doc spc scl diam manhol tOff lEnt lObj lLen lSpt lEpt lAng lMid tStr tBox tHgt tWid Mtxt mVec MtxtiPt) (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 -->")) (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 5.0)) (initget 6) (setq diam (getreal (strcat "\nSepcify 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))) tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox)) Mtxt (vla-addMText spc (vlax-3D-point lMid) (+ 2.0 tWid) tStr)) (vla-put-height Mtxt (* 0.1 scl)) (setq mVec (list (- (caar tBox) (/ tWid 2.0)) (+ (cadar tBox) tHgt))) (vla-move Mtxt (vlax-3D-point '(0 0 0)) (vlax-3D-point mVec)) (vla-put-AttachmentPoint Mtxt acAttachmentPointBottomCenter) (vla-put-rotation Mtxt lAng) (vla-put-layer Mtxt "TXT-100") (vla-put-StyleName Mtxt (getvar "TEXTSTYLE")) (setq MtxtiPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint Mtxt)))) (vla-move Mtxt (vlax-3D-point MtxtiPt) (vlax-3D-point (polar MtxtiPt (+ lAng (/ pi 2)) pipe:tOff)))) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) Quote Link to comment Share on other sites More sharing options...
Stryder Posted April 10, 2009 Author Share Posted April 10, 2009 AWESOME!!! One thing, and I should have mentioned this before. Sorry, my bad. Could the mtext width be zero? And this is just personal preference but could the default offset distance be 4 instead of 5? I tried to find in the code where to change the offset but I couldn't figure it out. BTW, I have been to the AfraLisp site and printed the AutoLisp Quick Start and hopefully I can start learning this stuff. It would be really nice to know. Thanks so much for the help, Stryder Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 10, 2009 Share Posted April 10, 2009 One thing, and I should have mentioned this before. Sorry, my bad. Could the mtext width be zero? Not sure what you mean by this? ~ if you mean the MTEXT bounding box, then no, but could you elborate please And this is just personal preference but could the default offset distance be 4 instead of 5? Altered for you: (defun c:pipetxt (/ *error* vlst ovar doc spc scl diam manhol tOff lEnt lObj lLen lSpt lEpt lAng lMid tStr tBox tHgt tWid Mtxt mVec MtxtiPt) (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 -->")) (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 [color=Red][b]4.0[/b][/color])) (initget 6) (setq diam (getreal (strcat "\nSepcify 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))) tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox)) Mtxt (vla-addMText spc (vlax-3D-point lMid) (+ 2.0 tWid) tStr)) (vla-put-height Mtxt (* 0.1 scl)) (setq mVec (list (- (caar tBox) (/ tWid 2.0)) (+ (cadar tBox) tHgt))) (vla-move Mtxt (vlax-3D-point '(0 0 0)) (vlax-3D-point mVec)) (vla-put-AttachmentPoint Mtxt acAttachmentPointBottomCenter) (vla-put-rotation Mtxt lAng) (vla-put-layer Mtxt "TXT-100") (vla-put-StyleName Mtxt (getvar "TEXTSTYLE")) (setq MtxtiPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint Mtxt)))) (vla-move Mtxt (vlax-3D-point MtxtiPt) (vlax-3D-point (polar MtxtiPt (+ lAng (/ pi 2)) pipe:tOff)))) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 10, 2009 Share Posted April 10, 2009 Actually this is better: The method of rotating the MTEXT to align with the midpoint of the line left it mildly off-centre - this was more apparent for lines of greater angles. This new method overcomes that issue: (defun c:pipetxt (/ *error* vlst ovar doc spc scl diam manhol tOff lEnt lObj lLen lSpt lEpt lAng lMid tStr tBox tHgt tWid @tplft @botcen VecLen VecAng Mtxt mVec MtxtiPt) (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 -->")) (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 "\nSepcify 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))))) tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox)) @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-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")) (setq MtxtiPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint Mtxt)))) (vla-move Mtxt (vlax-3D-point MtxtiPt) (vlax-3D-point (polar MtxtiPt (+ lAng (/ pi 2)) pipe:tOff)))) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) Quote Link to comment Share on other sites More sharing options...
Stryder Posted April 10, 2009 Author Share Posted April 10, 2009 Thanks for the updates! What I mean by the width is if you select the mtext that is inserted by the lisp and then check the properties, there is a defined width of 184. I don't know what variable or setting could change this but I would like it to be 0 so there is no word wrap. If this is not possible it isn't a big deal, the lisp still works GREAT!!! Thanks, Stryder Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 10, 2009 Share Posted April 10, 2009 No probs - that should be OK: (defun c:pipetxt (/ *error* vlst ovar doc spc scl diam manhol tOff lEnt lObj lLen lSpt lEpt lAng lMid tStr tBox tHgt tWid @tplft @botcen VecLen VecAng Mtxt mVec MtxtiPt) (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 -->")) (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 "\nSepcify 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))))) tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox)) @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-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")) (setq MtxtiPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint Mtxt)))) (vla-move Mtxt (vlax-3D-point MtxtiPt) (vlax-3D-point (polar MtxtiPt (+ lAng (/ pi 2)) pipe:tOff))) (vla-put-width Mtxt 0)) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) Quote Link to comment Share on other sites More sharing options...
Stryder Posted April 10, 2009 Author Share Posted April 10, 2009 Closer... It is putting the text below the line?? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 10, 2009 Share Posted April 10, 2009 Closer... It is putting the text below the line?? Hmm... I can't seem to replicate that Will experiment some more Quote Link to comment Share on other sites More sharing options...
Stryder Posted April 10, 2009 Author Share Posted April 10, 2009 Must be a messed up setting in that drawing because I opened another drawing and it works fine. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 10, 2009 Share Posted April 10, 2009 Actually Stryder, there was something wrong - I missed it - when you put the width as 0, it sometimes messed up the positioning, try these two out, let me know which one you like best (defun c:pipetxt (/ *error* vlst ovar doc spc scl diam manhol tOff lEnt lObj lLen lSpt lEpt lAng lMid tStr tBox tHgt tWid @tplft @botcen VecLen VecAng Mtxt mVec MtxtiPt) (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 -->")) (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)) (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)))) tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox)) @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-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")) (vla-put-width Mtxt 0) (setq MtxtiPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint Mtxt)))) (vla-move Mtxt (vlax-3D-point MtxtiPt) (vlax-3D-point (polar MtxtiPt (+ lAng (/ pi 2)) pipe:tOff)))) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) This is my favourite: (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) (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)) (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)))) tHgt (- (cadadr tBox) (cadar tBox)) tWid (- (caadr tBox) (caar tBox))) (while (= 5 (car (setq gr#drag (grread t 1)))) (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 @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))) (vla-put-AttachmentPoint Mtxt acAttachmentPointBottomCenter) (vla-put-layer Mtxt "TXT-100") (vla-put-StyleName Mtxt (getvar "TEXTSTYLE")) (redraw)) (mapcar 'setvar vlst ovar) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) Quote Link to comment Share on other sites More sharing options...
Stryder Posted April 13, 2009 Author Share Posted April 13, 2009 Well, the first code you posted was missing something. When I tried to use it I got this error: Error: BAD ARGUMENT TYPE: NUMBERP: NIL So I compared them and thought it was missing this: (or pipe:tOff (setq pipe:tOff 4.0)) When I pasted that back into the lisp file it worked, but it would still offset under the line instead of over and it wasn't a distance of 4.0 it was 4.333333333. Not sure if you want to mess with trying to fix this as it may be something that is happening in my drawings only? Your favorite is freaking AWESOME!!! I really like it and it is cool, I just don't know that we can use it here in my office because we always want it to be the same distance off the line if we can, and manually picking a location makes that really hard to do. Having said all that, if you want to try and tweak this file some more that is obviously up to you, I am COMPLETELY satisfied with the previous lisp that had the mtext with a width. If you are going to tweak them I have a suggestion. Would it be possible to sort of combine the 2 together? Your favorite and the one with the constant distance? I don't know if it is possible but maybe it could be the distance of 4 unless you press the ctrl key or enter an option to manually pick the location? Thanks, Stryder Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 13, 2009 Share Posted April 13, 2009 OK, hows this: it will align the text initially by the text offset setting that the user has entered - if you are satisfied, hit enter. If you want to adjust it, hit shift and click to where you want it. ;; 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)))) 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))) (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 Link to comment Share on other sites More sharing options...
Lee Mac Posted April 13, 2009 Share Posted April 13, 2009 As for the other code that I posted -- I accidentally edited the wrong code when I posted it and so that is why the error occurred, I apologise for this. Quote Link to comment Share on other sites More sharing options...
Stryder Posted April 13, 2009 Author Share Posted April 13, 2009 WOW!!! This new one is AWESOME!!! No apolgy needed for the accidental editing the wrong code either. This is really an awesome lisp now. Thank you very much for your time and help. The guys here at work and I are sort of stunned that this was all possible and that you were able to do it in such a little amount of time. Again nice work and thank you very much, Stryder P.S. I have another project we are messing with, it is WAY more complicated and I will start a new thread for it. You may not want to mess with it and if so, I will understand. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 13, 2009 Share Posted April 13, 2009 WOW!!! This new one is AWESOME!!! No apolgy needed for the accidental editing the wrong code either. This is really an awesome lisp now. Thank you very much for your time and help. The guys here at work and I are sort of stunned that this was all possible and that you were able to do it in such a little amount of time. Thanks Stryder, your compliments are much appreciated P.S. I have another project we are messing with, it is WAY more complicated and I will start a new thread for it. You may not want to mess with it and if so, I will understand. I shall look at it all the same, and if I get a minute, I'll see if I can lend a hand Its been fun working on this LISP with you - thanks Lee Quote Link to comment Share on other sites More sharing options...
NH3man! Posted April 13, 2009 Share Posted April 13, 2009 Good work Lee. Very nice of you!!! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 13, 2009 Share Posted April 13, 2009 Good work Lee. Very nice of you!!! Thanks, NH3man Quote Link to comment Share on other sites More sharing options...
Stryder Posted April 14, 2009 Author Share Posted April 14, 2009 I know that there is a point to where I am asking the lisp to do too much, so just tell me if it is getting to be too much. I think after this I will leave it alone. I have noticed that when the manholes are less than 165 ft. apart the text width needs to be changed to 90 so it will stack. Is there a way to say (if the selected line is less than 165 change the mtext width to 90?) Thanks, Stryder Its been fun working on this LISP with you - thanks Glad to know I am not being a pain! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 14, 2009 Share Posted April 14, 2009 Not too much trouble Stryder, had to alter the "preview box" dimensions to account for the height and width changes, so that you had an accurate representation - also, the rotation and movement factors had to be tweaked, but other than that, here goes.... ;; 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 'TEXTSIZE) (getvar 'TSPACEFAC)) (* 2.0 (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) (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 Link to comment Share on other sites More sharing options...
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.