Stryder Posted July 30, 2009 Author Posted July 30, 2009 It has been a while but if at all possible I would like to get an update to this lisp. As if the string of text wasn't long enough I need to add to it. Instead of only the decimal form I need a percentage added to it. So, where it used to read: 363 L.F. OF 8" P.V.C. @ 0.037 SLOPE It needs to read: 363 L.F. OF 8" P.V.C. @ 0.037 SLOPE (3.7%) Thanks, Stryder Quote
Lee Mac Posted July 30, 2009 Posted July 30, 2009 This seems like such a long time ago! I think I may re-write this one to make it better Quote
Lee Mac Posted July 30, 2009 Posted July 30, 2009 Try this: ;; Pipe Text Marker by Lee McDonnell 13.04.2009 ;;; Updated 30.07.2009 (Lee McDonnell) (defun c:pipetxt (/ *error* CANG COBJ CPT DIAM DOC GR LANG LENT LEPT LLEN LMID LSLP LSPT MANHOL MSG OSPT OVAR PT SCL SPC TBOX TOBJ TSTR TSZE TWID VLST WBSE XDIS) (vl-load-com) (defun *error* (msg) (if doc (vla-EndUndoMark doc)) (if ovar (mapcar 'setvar vlst ovar)) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n** Error: " msg " **")) (princ "\n*Cancel*")) (redraw) (princ)) (setq vlst '("CLAYER" "DIMZIN") ovar (mapcar 'getvar vlst)) (mapcar 'setvar (cdr vlst) '(1)) (if (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER")))))) (progn (princ "\n<< Current Layer Locked >>") (exit))) (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 *Mac$Per* (setq *Mac$Per* (/ pi 2.))) (or *Mac$tOff* (setq *Mac$tOff* 1.)) (initget 6) (or (not (setq diam (getreal (strcat "\nSpecify Diameter of Pipeline <" (rtos pip:dia 2 0) "\">: ")))) (setq pip:dia diam)) (initget 6) (or (not (setq manhol (getreal (strcat "\nSpecify Manhole Diameter <" (rtos man:hol 2 2) "'>: ")))) (setq man:hol manhol)) (while (and (setq lEnt (car (entsel "\nSelect Pipeline: "))) (eq "LINE" (cdadr (entget lEnt)))) (setq cObj (vlax-ename->vla-object lEnt) lSpt (vlax-curve-getStartPoint cObj) lEpt (vlax-curve-getEndPoint cObj) 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 cObj (/ (vlax-curve-getEndParam cObj) 2.0))) (setq tStr (strcat (rtos lLen 2 0) " L.F. OF " (rtos pip:dia 2 0) "\"%%C P.V.C. @ " lSlp " SLOPE (" (rtos (* (distof lSlp 2) 100.) 2 2) "%)") tSze (* 0.1 scl)) (setq tBox (textbox (list (cons 1 (strcat tStr "..")) (cons 40 tSze) (cons 7 (getvar "TEXTSTYLE")))) wBse (textbox (list (cons 1 ".") (cons 40 tSze) (cons 7 (getvar "TEXTSTYLE")))) wBse (- (caadr wBse) (caar wBse))) (vla-put-attachmentpoint (setq tObj (vla-addMText spc (vlax-3D-point '(0 0 0)) (setq tWid (- (caadr tBox) (caar tBox))) tStr)) acAttachmentPointMiddleCenter) (vla-put-Height tObj tSze) (vla-put-layer tObj "TXT-100") (setq msg (princ "\n<< Type [+] or [-] for offset, [P]er & [<] or [>] for MText Width >>")) ;; Place Text (while (progn (setq gr (grread t 15 0)) (redraw) (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr)))) (setq pt (vlax-curve-getClosestPointto cObj cPt)) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap pt (osLst (getvar "OSMODE"))))) (osMark osPt)) (setq cAng (angle pt cPt) lAng (+ cAng *Mac$Per*)) ;; Correct Angle (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-move tObj (vla-get-InsertionPoint tObj) (vlax-3D-point (polar pt cAng (* tSze *Mac$tOff*)))) (vla-put-Rotation tObj lAng) t) ((eq 2 (car gr)) (cond ((vl-position (cadr gr) '(43 61)) (setq *Mac$tOff* (+ (/ 1 10.) *Mac$tOff*))) ((eq (cadr gr) 45) (setq *Mac$tOff* (- *Mac$tOff* (/ 1 10.)))) ((eq 6 (cadr gr)) (cond ((< 0 (getvar "OSMODE") 16384) (setvar "OSMODE" (+ 16384 (getvar "OSMODE"))) (princ (strcat "\n<Osnap off>" msg))) (t (setvar "OSMODE" (- (getvar "OSMODE") 16384)) (princ (strcat "\n<Osnap on>" msg)))) t) ((vl-position (cadr gr) '(80 112)) (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*))) ((vl-position (cadr gr) '(60 44)) (if (> (- (vla-get-Width tObj) wBse) 0) (vla-put-Width tObj (- (vla-get-Width tObj) wBse))) t) ((vl-position (cadr gr) '(62 46)) (vla-put-Width tObj (+ (vla-get-Width tObj) wBse)) t) ((vl-position (cadr gr) '(13 32)) nil) (t))) ((eq 3 (car gr)) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap pt (osLst (getvar "OSMODE"))))) (progn (osMark osPt) (setq cAng (angle pt cPt) lAng (+ cAng *Mac$Per*)) ;; Correct Angle (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-move tObj (vla-get-InsertionPoint tObj) (vlax-3D-point (polar ospt cAng (* tSze *Mac$tOff*)))) (vla-put-Rotation tObj lAng))) nil) ((eq 25 (car gr)) nil) (t))))) (mapcar 'setvar vlst ovar) (redraw) (princ)) (princ "\n.: PipeText Loaded, type \"Pipetxt\" to invoke :.") (princ) (defun oSlst (os / str cnt) (setq str "" cnt 0) (if (< 0 os 16383) (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_non" "_app" "_ext" "_par") (if (not (zerop (logand (expt 2 cnt) os))) (setq str (strcat str mod (chr 44)))) (setq cnt (1+ cnt)))) (vl-string-right-trim (chr 44) str)) (defun osMark (pt / drft osSz osCol ratio bold glst i) (setq drft (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))) osSz (vla-get-AutoSnapMarkerSize drft) oscol (vla-get-AutoSnapMarkerColor drft) ratio (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) bold (mapcar (function (lambda (x) (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0) (repeat 50 (setq glst (cons (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i))) (foreach x bold (grvecs (append (list oscol) glst (cdr glst) (list (car glst))) (list (list x 0.0 0.0 (car pt)) (list 0.0 x 0.0 (cadr pt)) (list 0.0 0.0 1.0 0.0) (list 0.0 0.0 0.0 1.0))))) Quote
Stryder Posted July 30, 2009 Author Posted July 30, 2009 GENIUS!!! I love it!!! I may bring this post back up every 2 months just to see if there is anything you want to do to make it better! Thanks for the update and the quick response as usual!!! Later, Stryder Quote
Lee Mac Posted July 30, 2009 Posted July 30, 2009 Cheers Stryder, I have learnt a lot more since we last spoke, so I just applied the new knowledge Glad you like it, Lee Quote
Stryder Posted October 13, 2009 Author Posted October 13, 2009 I am back... I have a request for this lisp. I really love it and it makes my life at work so much easier. However, the latest change with the for text width and the + - for the distance off the line is getting to be a chore when I have to label hundreds of pipes in a project. So, I don't know if this is possible but it might work better if I could designate how many lines of text I want it to use. Maybe there could be a promt to ask me how many lines of text I want. If this isn't possible we could just go back to the way it was. If it is less than a certain number it would make it 2 lines and the same for 3 lines. Thanks, Stryder Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.