Jump to content

Lisp file request

Stryder

By Stryder
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Stryder Explorer

Stryder

Posted
  • Author
Posted

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

Link to comment
Share on other sites
  • Replies 65
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    34

  • Stryder

    27

  • NH3man!

    2

  • CarlB

    1

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Lee Mac Grand Master

Lee Mac

Posted
Posted
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...

Link to comment
Share on other sites
Stryder Explorer

Stryder

Posted
  • Author
Posted

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.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

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)

Link to comment
Share on other sites
Stryder Explorer

Stryder

Posted
  • Author
Posted

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! :lol:

 

 

Thanks for the help,

Stryder

 

P.S. - Keep this up and I may get you on the payroll here!:wink:

Link to comment
Share on other sites
uddfl Rising Star

uddfl

Posted
Posted
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.
Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
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 :thumbsup:

 

P.S. - Keep this up and I may get you on the payroll here!:wink:

 

Now that would be a treat :D

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

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)

Link to comment
Share on other sites
Stryder Explorer

Stryder

Posted
  • Author
Posted

:D Awesome!!! :D

 

It is not exactly 4 every time but it is close enough. I am not building a piano or performing spinal sugery here. :lol:

 

 

Thanks so much for the help,

Stryder

 

P.S. I will post my new project tomorrow or maybe in about an hour. :)

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
:D Awesome!!! :D

 

It is not exactly 4 every time but it is close enough. I am not building a piano or performing spinal sugery here. :lol:

 

 

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

Link to comment
Share on other sites
NH3man! Collaborator

NH3man!

Posted
Posted

I watch you Lee in amazement! Your an extraordinary benefit to this community. I applaud you for all you efforts!

 

NH3man!

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
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

Link to comment
Share on other sites
Stryder Explorer

Stryder

Posted
  • Author
Posted

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

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
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

Link to comment
Share on other sites
Stryder Explorer

Stryder

Posted
  • Author
Posted

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?

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
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:

 

Ex1.jpg

 

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:

 

Ex2.jpg

 

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.

 

Ex3.jpg

 

I then move the text with a base point of the origin, by a displacement of this vector:

 

Ex4.jpg

 

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

Link to comment
Share on other sites
Stryder Explorer

Stryder

Posted
  • Author
Posted

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

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
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.

Link to comment
Share on other sites
Stryder Explorer

Stryder

Posted
  • Author
Posted

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. :)

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

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)

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...