scubastu Posted February 17, 2010 Posted February 17, 2010 Hi, I have crudely edited this and open to more streamline suggestions. First of all this lisp doesn't work correctly on some computers.. there is a system variable or something that snaps the text to the beginning and end of the line.. I still haven't found it but instead changed all workmate computers to imitate mine and it works... help would be nice to find it.. ( :roll:still learning). Second.. how do I change this to include Polyline segments? I got a little confused between two programs.. a text rotate which has segments in it and this one. Both written completely different and I be LOST! ; From the Desk of Paul Standing ; Somewhere deep in space ; Annotate.lsp vs 1.0 April 18th 1995 ; program allows the user to annotate direction and distance to either ; side of a line drawn on the drawing screen. ;; ;;customised by scubastu 2009 (defun text_line (en txt side / txt_size el aa dd aa2 p1) (if (null txt_size)(setq txt_size (getvar "textsize"))) (if (and (= (type txt) 'str) (= (type en) 'ename)) (if (= "LINE" (cdr (assoc 0 (setq el (entget en))))) (progn (setq aa (angle (cdr (assoc 10 el)) (cdr (assoc 11 el))) dd (distance (cdr (assoc 10 el)) (cdr (assoc 11 el))) ) (if (< (/ pi 2) aa (* pi 1.5)) (setq p1 (cdr (assoc 11 el)) aa (rem (+ aa pi)(* pi 2))) (setq p1 (cdr (assoc 10 el)))) (setq p1 (polar (polar p1 aa (/ dd 2)) (if (null side) (+ aa (/ pi 2)) (- aa (/ pi 2))) txt_size)) (if txt (setq txt (vl-string-subst "° " "d" txt))) (if txt (setq txt (vl-string-subst "' " "'" txt))) (if txt (setq txt (vl-string-subst "\" " "\"" txt))) (if txt (setq txt (vl-string-subst " 00' " " 0'" txt))) (if txt (setq txt (vl-string-subst " 01' " " 1'" txt))) (if txt (setq txt (vl-string-subst " 02' " " 2'" txt))) (if txt (setq txt (vl-string-subst " 03' " " 3'" txt))) (if txt (setq txt (vl-string-subst " 04' " " 4'" txt))) (if txt (setq txt (vl-string-subst " 05' " " 5'" txt))) (if txt (setq txt (vl-string-subst " 06' " " 6'" txt))) (if txt (setq txt (vl-string-subst " 07' " " 7'" txt))) (if txt (setq txt (vl-string-subst " 08' " " 8'" txt))) (if txt (setq txt (vl-string-subst " 09' " " 9'" txt))) (if txt (setq txt (vl-string-subst " 00\" " " 0\"" txt))) (if txt (setq txt (vl-string-subst " 01\" " " 1\"" txt))) (if txt (setq txt (vl-string-subst " 02\" " " 2\"" txt))) (if txt (setq txt (vl-string-subst " 03\" " " 3\"" txt))) (if txt (setq txt (vl-string-subst " 04\" " " 4\"" txt))) (if txt (setq txt (vl-string-subst " 05\" " " 5\"" txt))) (if txt (setq txt (vl-string-subst " 06\" " " 6\"" txt))) (if txt (setq txt (vl-string-subst " 07\" " " 7\"" txt))) (if txt (setq txt (vl-string-subst " 08\" " " 8\"" txt))) (if txt (setq txt (vl-string-subst " 09\" " " 9\"" txt))) (command "text" "m" p1 txt_size (angtos aa) txt) txt))) ) (defun C:annot (/ en el ) (vl-load-com) (setvar "cmdecho" 0) (while (setq en (car (entsel "\nPick a Line: ")) el (entget en)) (if (= (cdr (assoc 0 el)) "LINE") (progn (text_line en (rtos (distance (cdr (assoc 10 el)) (cdr (assoc 11 el))) 2 2) nil) (text_line en (angtos (angle (cdr (assoc 10 el)) (cdr (assoc 11 el))) 1 4) 1) ) )) (setvar "cmdecho" 1) (princ) ) Quote
Lee Mac Posted February 17, 2010 Posted February 17, 2010 Hey ScubaStu, You can select anything you like with this: (defun c:annot (/ *error* text ANG ENT LEN MPT UFLAG) (vl-load-com) ; Lee Mac ~ 17.02.10 (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object))))) (defun *error* (msg) (and uFlag (vla-EndUndoMark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Text (pt hgt str rot) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 rot) (cons 72 1) (cons 73 2) (cons 11 pt)))) (while (progn (setq ent (car (entsel))) (cond ( (eq 'ENAME (type ent)) (if (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam) (list ent))) (princ "\n** Invalid Object **") (progn (setq uFlag (not (vla-StartUndoMark *doc))) (setq Ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent (setq mPt (vlax-curve-getPointatDist ent (/ (setq len (vlax-curve-getDistatParam ent (vlax-curve-getEndParam ent))) 2.))))))) (cond ( (and (> Ang (/ pi 2)) (<= Ang pi)) (setq Ang (- Ang pi))) ( (and (> Ang pi) (<= Ang (/ (* 3 pi) 2))) (setq Ang (+ Ang pi)))) (mapcar (function (lambda (foo) (text (polar mPt ((eval foo) Ang (/ pi 2.)) (getvar 'TEXTSIZE)) (getvar 'TEXTSIZE) (rtos len (getvar 'LUNITS) (getvar 'LUPREC)) Ang))) '(+ -)) (setq uFlag (vla-EndUndoMark *doc)))))))) (princ)) Quote
Lee Mac Posted February 17, 2010 Posted February 17, 2010 Or, if you prefer: (defun c:annot2 (/ *error* text ANG ENT I LEN MPT SS UFLAG) (vl-load-com) ; Lee Mac ~ 17.02.10 (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object))))) (defun *error* (msg) (and uFlag (vla-EndUndoMark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Text (pt hgt str rot) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 rot) (cons 72 1) (cons 73 2) (cons 11 pt)))) (if (setq i -1 ss (ssget '((0 . "LINE,*POLYLINE,ARC,ELLIPSE,CIRCLE")))) (while (setq ent (ssname ss (setq i (1+ i)))) (setq uFlag (not (vla-StartUndoMark *doc))) (setq Ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent (setq mPt (vlax-curve-getPointatDist ent (/ (setq len (vlax-curve-getDistatParam ent (vlax-curve-getEndParam ent))) 2.))))))) (cond ( (and (> Ang (/ pi 2)) (<= Ang pi)) (setq Ang (- Ang pi))) ( (and (> Ang pi) (<= Ang (/ (* 3 pi) 2))) (setq Ang (+ Ang pi)))) (mapcar (function (lambda (foo) (text (polar mPt ((eval foo) Ang (/ pi 2.)) (getvar 'TEXTSIZE)) (getvar 'TEXTSIZE) (rtos len (getvar 'LUNITS) (getvar 'LUPREC)) Ang))) '(+ -)) (setq uFlag (vla-EndUndoMark *doc)))) (princ)) Quote
scubastu Posted February 17, 2010 Author Posted February 17, 2010 Hey ScubaStu, You can select anything you like with this:QUOTE] Thanks Lee, just one thing.. I need the segment of the polyline that is selected not the whole thing. How can I nest this (defun getSegment (obj pt / cpt eParam stParam) (cond ((setq cpt (vlax-curve-getClosestPointTo obj pt)) (setq eParam (fix (vlax-curve-getEndParam obj))) (if (= eParam (setq stParam (fix (vlax-curve-getParamAtPoint obj cpt)))) (setq stParam (1- stParam)) (setq eParam (1+ stParam)) ) (list eParam (vlax-curve-getPointAtParam obj stParam) (vlax-curve-getPointAtParam obj eParam)) ) ) ) into your program? ..and get bearing and distance from it? Quote
Lee Mac Posted February 17, 2010 Posted February 17, 2010 Thanks Lee, just one thing.. I need the segment of the polyline that is selected not the whole thing. How can I nest this ..and get bearing and distance from it? You want bearing (is that measured from pi/2 radians clockwise?) and distance (length of segment? or length from start point of polyline?). *Sorry, programmer, not a draftsman * Lee Quote
scubastu Posted February 17, 2010 Author Posted February 17, 2010 You want bearing (is that measured from pi/2 radians clockwise?) and distance (length of segment? or length from start point of polyline?). *Sorry, programmer, not a draftsman * Lee Definitely No appologies needed Lee.. I know I am in debted to you and your programs!!! I wish I had your understanding! ok.. I work in metric and in azimuth (clockwise, dd.mm.ss, from North as direction) from a point. Length and azimuth would be for the Polyline segment only... just as if the polyline was exploded. If the direction, angle and distance is dependant on sysvar Units then we should be all go. Thanks again!!! Quote
Lee Mac Posted February 18, 2010 Posted February 18, 2010 No problem Stu, I shall see what I can do when I get some free time Quote
Lee Mac Posted February 18, 2010 Posted February 18, 2010 Hi Stu, Try this: (defun c:annot (/ *error* text ANG BEAR ENT LEN LST MPT P1 P2 PT STR UFLAG) (vl-load-com) ; Lee Mac ~ 17.02.10 (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object))))) (defun *error* (msg) (and uFlag (vla-EndUndoMark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Text (pt hgt str rot) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 rot) (cons 72 1) (cons 73 2) (cons 11 pt)))) (while (progn (setq lst (entsel) ent (car lst) pt (cadr lst)) (cond ( (eq 'ENAME (type ent)) (if (not (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")) (princ "\n** Invalid Object **") (progn (setq uFlag (not (vla-StartUndoMark *doc))) (setq p1 (fix (vlax-curve-getParamatPoint ent (vlax-curve-getClosestPointto ent pt))) p2 (1+ p1) Ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ p1 0.5))) mPt (vlax-curve-getPointatParam ent (+ p1 0.5))) (setq len (- (vlax-curve-getDistatParam ent p2) (vlax-curve-getDistatParam ent p1)) bear (rem (- 450 (* 180. (/ Ang pi))) 360.)) (cond ( (and (> Ang (/ pi 2)) (<= Ang pi)) (setq Ang (- Ang pi))) ( (and (> Ang pi) (<= Ang (/ (* 3 pi) 2))) (setq Ang (+ Ang pi)))) (setq str (strcat (rtos len (getvar 'LUNITS) (getvar 'LUPREC)) " @ " (rtos bear 2 (getvar 'AUPREC)) (chr 186))) (mapcar (function (lambda (foo) (text (polar mPt ((eval foo) Ang (/ pi 2.)) (getvar 'TEXTSIZE)) (getvar 'TEXTSIZE) str Ang))) '(+ -)) (setq uFlag (vla-EndUndoMark *doc)))))))) (princ)) Quote
scubastu Posted February 18, 2010 Author Posted February 18, 2010 Hi Stu, Try this: Thanks again Lee:) Quote
Lee Mac Posted February 18, 2010 Posted February 18, 2010 Thanks again Lee:) You're welcome Stu Quote
rmwilson Posted February 27, 2013 Posted February 27, 2013 Lee Mac, I've used this program quite often lately..Thanks by the way. Of recent I've selected several 3d polylines that respond with a numberp error. If I rotate the line say .0001, it seems to label just fine. Your help would be much appreciated. Again thanks for its use. Hi Stu, Try this: (defun c:annot (/ *error* text ANG BEAR ENT LEN LST MPT P1 P2 PT STR UFLAG) (vl-load-com) ; Lee Mac ~ 17.02.10 (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object))))) (defun *error* (msg) (and uFlag (vla-EndUndoMark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Text (pt hgt str rot) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 rot) (cons 72 1) (cons 73 2) (cons 11 pt)))) (while (progn (setq lst (entsel) ent (car lst) pt (cadr lst)) (cond ( (eq 'ENAME (type ent)) (if (not (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")) (princ "\n** Invalid Object **") (progn (setq uFlag (not (vla-StartUndoMark *doc))) (setq p1 (fix (vlax-curve-getParamatPoint ent (vlax-curve-getClosestPointto ent pt))) p2 (1+ p1) Ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ p1 0.5))) mPt (vlax-curve-getPointatParam ent (+ p1 0.5))) (setq len (- (vlax-curve-getDistatParam ent p2) (vlax-curve-getDistatParam ent p1)) bear (rem (- 450 (* 180. (/ Ang pi))) 360.)) (cond ( (and (> Ang (/ pi 2)) (<= Ang pi)) (setq Ang (- Ang pi))) ( (and (> Ang pi) (<= Ang (/ (* 3 pi) 2))) (setq Ang (+ Ang pi)))) (setq str (strcat (rtos len (getvar 'LUNITS) (getvar 'LUPREC)) " @ " (rtos bear 2 (getvar 'AUPREC)) (chr 186))) (mapcar (function (lambda (foo) (text (polar mPt ((eval foo) Ang (/ pi 2.)) (getvar 'TEXTSIZE)) (getvar 'TEXTSIZE) str Ang))) '(+ -)) (setq uFlag (vla-EndUndoMark *doc)))))))) (princ)) Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.