Lisp file request

April 10, 2009

I think that is definitely possible - I shall get on to it tomorrow

Cheers

Lee

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)

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

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)

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)

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

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)

April 10, 2009

Closer... It is putting the text below the line??

April 10, 2009

Closer... It is putting the text below the line??

Hmm... I can't seem to replicate that

Will experiment some more

April 10, 2009

Must be a messed up setting in that drawing because I opened another drawing and it works fine.

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)

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

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)

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.

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.

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

April 13, 2009

Good work Lee. Very nice of you!!!

April 13, 2009

Good work Lee. Very nice of you!!!

Thanks, NH3man

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!

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)

Sign In

Lisp file request

Recommended Posts

Lee Mac

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Lee Mac

Stryder

Lee Mac

Lee Mac

Stryder

Lee Mac

Stryder

Lee Mac

Stryder

Lee Mac

Stryder

Lee Mac

Lee Mac

Stryder

Lee Mac

NH3man!

Lee Mac

Stryder

Lee Mac

Join the conversation

Tutorials

Forums

Activity