alanjt Posted March 4, 2010 Share Posted March 4, 2010 Thanks Alan, I'm always at a loss as to what TextSize to use... I've seen this also used: (getvar 'DIMTXT) Which may be better in this situation. Lee That's why I just use MText. Plus, you can add a mask, if needed. (getvar 'dimtxt) will still be off if annotative. Command: (getvar 'textsize) 0.08 Command: (getvar 'dimtxt) 0.08 I've seen Alan (CAB) use that, but he's 00 and 06 (no Annotative objects). Quote Link to comment Share on other sites More sharing options...
pontifex Posted March 4, 2010 Author Share Posted March 4, 2010 About text height and drawing scale. Don't really know how or where to lisp it, but maybe it would be possible to let the user choose the drawing scale at the beginning jus like it is in this code (btw the code You wrote, Lee:) ). It seem to work great there so maybe could work here too. (defun c:elleve (/ *error* #Dimzin Line Text P1 P2 PT TSZE X Y) ;; Lee Mac ~ 01.03.10 (defun *error* (msg) (and #Dimzin (setvar 'dimzin #Dimzin)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 1 str) (cons 50 (angle '(0 0 0) (getvar 'UCSXDIR))) (cons 7 (getvar 'TEXTSTYLE))))) (setq #Dimzin (getvar 'dimzin)) (setvar 'dimzin 0) (or *scl (setq *scl 100)) (initget 6) (setq *scl (cond ((getint (strcat "\nEnter Drawing Scale <" (itoa *scl) "> : "))) (*scl))) (setq tsze (* 0.002 *scl)) (while (setq pt (getpoint "\nPick Elevation Line Point: ")) (setq x (car pt) y (cadr pt)) (setq p1 (trans (list (- x (/ tsze 2)) (+ y tsze) 0.) 1 0) p2 (trans (list (+ x (/ tsze 2)) (+ y tsze) 0.) 1 0)) (mapcar (function (lambda (x) (line (trans pt 1 0) x))) (list p1 p2)) (line p1 p2) (Text (trans (list x (+ y tsze) 0.) 1 0) tsze (strcat (if (<= 0 y) "+" "") (rtos y 2 2)))) (and #Dimzin (setvar 'dimzin #Dimzin)) (princ)) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 4, 2010 Share Posted March 4, 2010 I've seen Alan (CAB) use that, but he's 00 and 06 (no Annotative objects). Yeah, that's where I've picked it up from... Quote Link to comment Share on other sites More sharing options...
alanjt Posted March 4, 2010 Share Posted March 4, 2010 I forgot to mention. I noticed this typo... (setq tObj (vla-AddText (if (zerop (vla-get-ActiveSpace *doc) ) ;_ zerop (if (eq :vlax-true (vla-get-MSpace [color=Red]*doc_[/color]) ) ;_ eq (vla-get-ModelSpace *doc) (vla-get-PaperSpace *doc) ) ;_ if (vla-get-ModelSpace *doc) ) ;_ if (rtos dist 2 2) (vlax-3D-point '(0 0 0) ) ;_ vlax-3D-point (getvar 'TEXTSIZE) ) ;_ vla-AddText ) ;_ setq Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 4, 2010 Share Posted March 4, 2010 Nice spot! I think I perhaps wrote it too quickly ... I knew exactly what I wanted to code, but my fingers couldn't type fast enough... Quote Link to comment Share on other sites More sharing options...
alanjt Posted March 4, 2010 Share Posted March 4, 2010 Nice spot! I think I perhaps wrote it too quickly ... I knew exactly what I wanted to code, but my fingers couldn't type fast enough... Happens to the best of 'em. Quote Link to comment Share on other sites More sharing options...
Kerry Brown Posted March 4, 2010 Share Posted March 4, 2010 Well, spurred on from Kerry's comments I thoughts I'd see how it would look - but I don't like it to be honest, so I'll probably go back to my old style. get rid of the closing comments and it will be perfect Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 4, 2010 Share Posted March 4, 2010 get rid of the closing comments and it will be perfect Hehe, I wondered how long it'd be before you stumbled across this... I bet your ears were burning Quote Link to comment Share on other sites More sharing options...
Kerry Brown Posted March 4, 2010 Share Posted March 4, 2010 Hehe, I wondered how long it'd be before you stumbled across this... I bet your ears were burning yep, how does this look to you ?? (defun c:int_dist (/ *error* iscurveobj ss->list vlax-list->3d-point sortfrompt dist ent ilst lang ma mi mpt obj pt ss tobj uflag ) (vl-load-com) ;; ;; Lee Mac ~ 04.03.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 iscurveobj (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getendparam) (list ent) ) ) ) ) (defun ss->list (ss / i ent objlst) (setq i -1) (while (setq ent (ssname ss (setq i (1+ i)))) (setq objlst (cons (vlax-ename->vla-object ent) objlst)) ) objlst ) (defun vlax-list->3d-point (lst) (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (vlax-list->3d-point (cdddr lst)) ) ) ) (defun sortfrompt (pt lst) (vl-sort lst (function (lambda (a b) (< (distance a pt) (distance b pt)))) ) ) (while (progn (setq ent (entsel) pt (cadr ent) ent (car ent) ) (cond ((eq 'ename (type ent)) (if (iscurveobj ent) (progn (vla-getboundingbox (setq obj (vlax-ename->vla-object ent)) 'mi 'ma ) (mapcar (function set) '(mi ma) (mapcar (function vlax-safearray->list) (list mi ma)) ) (setq ss (ssget "_C" (list (car mi) (cadr ma) 0.) (list (car ma) (cadr mi) 0.) ) ) (if (and (setq ilst (apply (function append) (vl-remove 'nil (mapcar (function (lambda (x) (vlax-list->3d-point (vlax-invoke obj 'intersectwith x acextendnone ) ) ) ) (ss->list (ssdel ent ss)) ) ) ) ) (< 1 (length ilst)) ) (progn (setq uflag (not (vla-startundomark *doc))) (setq ilst (sortfrompt (vlax-curve-getclosestpointto ent pt) ilst ) ilst (list (car ilst) (cadr ilst)) ) (setq mpt (vlax-curve-getpointatdist ent (/ (+ (vlax-curve-getdistatpoint ent (cadr ilst) ) (vlax-curve-getdistatpoint ent (car ilst) ) ) 2. ) ) ) (setq dist (abs (- (vlax-curve-getdistatpoint ent (cadr ilst) ) (vlax-curve-getdistatpoint ent (car ilst)) ) ) ) (setq lang (angle '(0 0 0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent mpt) ) ) ) (cond ((and (> lang (/ pi 2)) (<= lang pi)) (setq lang (- lang pi)) ) ((and (> lang pi) (<= lang (/ (* 3 pi) 2))) (setq lang (+ lang pi)) ) ) (setq tobj (vla-addtext (if (zerop (vla-get-activespace *doc)) (if (eq :vlax-true (vla-get-mspace *doc)) (vla-get-modelspace *doc) (vla-get-paperspace *doc) ) (vla-get-modelspace *doc) ) (rtos dist 2 2) (vlax-3d-point '(0 0 0)) (getvar 'textsize) ) ) (vla-put-alignment tobj acalignmentmiddlecenter) (vla-put-textalignmentpoint tobj (vlax-3d-point (polar mpt (+ lang (/ pi 2.)) (getvar 'textsize)) ) ) (vla-put-stylename tobj (getvar 'dimtxsty)) (vla-put-rotation tobj lang) (setq uflag (vla-endundomark *doc)) ) (princ "\n** Object Has less than Two Intersections **" ) ) ) (princ "\n** Invalid Object Selected **") ) ) ) ) ) (princ) ) ;|«Visual LISP© Format Options» (70 2 45 2 nil "end of " 70 60 1 1 0 nil nil nil T) ;*** DO NOT add text below the comment! ***|; Quote Link to comment Share on other sites More sharing options...
Kerry Brown Posted March 4, 2010 Share Posted March 4, 2010 Nice functionality, BTW Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 4, 2010 Share Posted March 4, 2010 Thanks Kerry Yeah, it does flow, but I do struggle to read it if I'm honest... but that's just because I have gotten so used to my style. I've never liked the Visual LISP format options at the bottom, I've always thought that was the worst thing to come from the Visual LISP Editor... its so intrusive.. I take it you don't like capitals then... I love my CamelCase Quote Link to comment Share on other sites More sharing options...
Kerry Brown Posted March 4, 2010 Share Posted March 4, 2010 Thanks Kerry Yeah, it does flow, but I do struggle to read it if I'm honest... but that's just because I have gotten so used to my style. I've never liked the Visual LISP format options at the bottom, I've always thought that was the worst thing to come from the Visual LISP Editor... its so intrusive.. I take it you don't like capitals then... I love my CamelCase Yes I prefer camelCase personally I left the definition at the bottom in case you wanted to import it and try. I've heard some whispers about an update for the VLIDE ... will be interesting to see what they come up with. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 4, 2010 Share Posted March 4, 2010 I've heard some whispers about an update for the VLIDE ... will be interesting to see what they come up with. Ooo I can't wait Quote Link to comment Share on other sites More sharing options...
walton10 Posted March 17, 2010 Share Posted March 17, 2010 I came across this thread while looking for a LISP to measure a polyline. I like what it does, but one thing that would work better for the purposes I need it for would be if the segment of polyline measured was determined from intersecting lines from two lines selected by the user or as another solution, from a specific, preset layer. This code is probably beyond my capacity to edit (without breaking), but if someone was able to help I would be very thankful. (I am using AutoCAD 2008, but our office uses 2008 and 2010. We save all files to 2000, if that is relevant.) Also, I was looking at the code to see how to make it use my current text style (our company uses styles with pre-determined heights, etc), or make the lisp use a larger size. I only saw a limited number of references to 'TEXTSIZE and was unable to determine where it was defined. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 17, 2010 Share Posted March 17, 2010 Hi Walton, Welcome to CADTutor Glad you like the code, I'm not sure that I understand your request completely. There are currently two codes on this topic, the first will label all distances between intersections, and the second will label the length of the section selected by the user. Is there something that neither of these codes can achieve? (defun c:int_dist (/ *error* isCurveObj SortbyParam ss->list vlax-list->3D-point DIST ENT ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG X Y) (vl-load-com) ;; Lee Mac ~ 04.03.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 isCurveObj (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam) (list ent))))) (defun ss->list (ss / i ent ObjLst) (setq i -1) (while (setq ent (ssname ss (setq i (1+ i)))) (setq ObjLst (cons (vlax-ename->vla-object ent) Objlst))) ObjLst) (defun vlax-list->3D-point (lst) (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (vlax-list->3D-point (cdddr lst))))) (defun SortByParam (ent lst) (vl-sort lst (function (lambda (a b) (< (vlax-curve-getParamatPoint ent a) (vlax-curve-getParamatPoint ent b)))))) (while (progn (setq ent (car (entsel))) (cond ( (eq 'ENAME (type ent)) (if (isCurveObj ent) (progn (vla-getBoundingBox (setq obj (vlax-ename->vla-object ent)) 'Mi 'Ma) (mapcar (function set) '(Mi Ma) (mapcar (function vlax-safearray->list) (list Mi Ma))) (setq ss (ssget "_C" (trans (list (car Mi) (cadr Ma) 0.) 0 1) (trans (list (car Ma) (cadr Mi) 0.) 0 1))) (if (setq iLst (apply (function append) (vl-remove 'nil (mapcar (function (lambda (x) (vlax-list->3D-point (vlax-invoke obj 'IntersectWith x acExtendNone)))) (ss->list (ssdel ent ss)))))) (progn (setq iLst (SortByParam ent iLst)) (or (equal (vlax-curve-getStartParam ent) (vlax-curve-getParamatPoint ent (car iLst)) 0.001) (setq iLst (cons (vlax-curve-getStartPoint ent) iLst))) (or (equal (vlax-curve-getEndParam ent) (vlax-curve-getParamatPoint ent (last iLst)) 0.001) (setq iLst (append iLst (list (vlax-curve-getEndPoint ent)))))) (setq iLst (list (vlax-curve-getStartPoint ent) (vlax-curve-getEndPoint ent)))) (while (cadr iLst) (setq x (car iLst) y (cadr iLst)) (setq mPt (vlax-curve-getPointatDist ent (/ (+ (vlax-curve-getDistatPoint ent y) (vlax-curve-getDistAtPoint ent x)) 2.)) dist (abs (- (vlax-curve-getDistatPoint ent y) (vlax-curve-getDistAtPoint ent x))) lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent mPt)))) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq uFlag (not (vla-StartUndoMark *doc))) (setq tObj (vla-AddText (if (zerop (vla-get-ActiveSpace *doc)) (if (eq :vlax-true (vla-get-MSpace *doc)) (vla-get-ModelSpace *doc) (vla-get-PaperSpace *doc)) (vla-get-ModelSpace *doc)) (rtos dist) (vlax-3D-point '(0 0 0)) (getvar 'TEXTSIZE))) (vla-put-Alignment tObj acAlignmentMiddleCenter) (vla-put-TextAlignmentPoint tObj (vlax-3D-point (polar mPt (+ lAng (/ pi 2.)) (getvar 'TEXTSIZE)))) (vla-put-rotation tObj lAng) (setq iLst (cdr iLst))) (setq uFlag (vla-EndUndomark *doc))) (princ "\n** Invalid Object Selected **")))))) (princ)) (defun c:int_dist_seg (/ *error* isCurveObj ss->list vlax-list->3D-point SortFromPt DIST ENT ILST LANG MA MI MPT OBJ PT SS TOBJ UFLAG) (vl-load-com) ;; Lee Mac ~ 04.03.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 isCurveObj (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam) (list ent))))) (defun ss->list (ss / i ent ObjLst) (setq i -1) (while (setq ent (ssname ss (setq i (1+ i)))) (setq ObjLst (cons (vlax-ename->vla-object ent) Objlst))) ObjLst) (defun vlax-list->3D-point (lst) (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (vlax-list->3D-point (cdddr lst))))) (defun SortFromPt (pt lst) (vl-sort lst (function (lambda (a b) (< (distance a pt) (distance b pt)))))) (while (progn (setq ent (entsel) pt (cadr ent) ent (car ent)) (cond ( (eq 'ENAME (type ent)) (if (isCurveObj ent) (progn (vla-getBoundingBox (setq obj (vlax-ename->vla-object ent)) 'Mi 'Ma) (mapcar (function set) '(Mi Ma) (mapcar (function vlax-safearray->list) (list Mi Ma))) (setq ss (ssget "_C" (trans (list (car Mi) (cadr Ma) 0.) 0 1) (trans (list (car Ma) (cadr Mi) 0.) 0 1))) (if (and (setq iLst (apply (function append) (vl-remove 'nil (mapcar (function (lambda (x) (vlax-list->3D-point (vlax-invoke obj 'IntersectWith x acExtendNone)))) (ss->list (ssdel ent ss)))))) (< 1 (length iLst))) (progn (setq uFlag (not (vla-StartUndoMark *doc))) (setq iLst (SortFromPt (vlax-curve-getClosestPointto ent pt) iLst) iLst (list (car iLst) (cadr iLst))) (setq mPt (vlax-curve-getPointatDist ent (/ (+ (vlax-curve-getDistatPoint ent (cadr iLst)) (vlax-curve-getDistAtPoint ent (car ilst))) 2.)) dist (abs (- (vlax-curve-getDistatPoint ent (cadr iLst)) (vlax-curve-getDistAtPoint ent (car ilst)))) lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamatPoint ent mPt)))) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (setq tObj (vla-AddText (if (zerop (vla-get-ActiveSpace *doc)) (if (eq :vlax-true (vla-get-MSpace *doc)) (vla-get-ModelSpace *doc) (vla-get-PaperSpace *doc)) (vla-get-ModelSpace *doc)) (rtos dist 2 2) (vlax-3D-point '(0 0 0)) (getvar 'TEXTSIZE))) (vla-put-Alignment tObj acAlignmentMiddleCenter) (vla-put-TextAlignmentPoint tObj (vlax-3D-point (polar mPt (+ lAng (/ pi 2.)) (getvar 'TEXTSIZE)))) (vla-put-StyleName tObj (getvar 'TEXTSTYLE)) (vla-put-rotation tObj lAng) (setq uFlag (vla-EndUndomark *doc))) (princ "\n** Object Has less than Two Intersections **"))) (princ "\n** Invalid Object Selected **")))))) (princ)) Lee Quote Link to comment Share on other sites More sharing options...
kasra Posted March 28, 2010 Share Posted March 28, 2010 Hi everyone. I like this froum. cause i love solving all my problems in autocad with programming. But I'm fresh in lisp programming. The routine that provided by Mr. Lee is so useful and I'm so thankful for that. But it will be more completed if it shows all distances between two intersections, while there is an End point of line or Start point of arc between intersections. I'm so glad if you complete that routine. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 28, 2010 Share Posted March 28, 2010 Thanks Kasra, I'm glad you like it I'm not sure what you are getting at, I believe the first routine in the above post should include the endpoints of the curve. Quote Link to comment Share on other sites More sharing options...
kasra Posted March 28, 2010 Share Posted March 28, 2010 Thanks Kasra, I'm glad you like it I'm not sure what you are getting at, I believe the first routine in the above post should include the endpoints of the curve. Thanks for your attention. I used the first routine. but it doesn't work as I want. I 've sent a picture that indicates what i mean. The magenta dimentions do not display with this routine. I hope you understand what i mean. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted March 28, 2010 Share Posted March 28, 2010 Hi Kasra, With my quick testing of the first routine from post #35, I obtain this: Quote Link to comment Share on other sites More sharing options...
kasra Posted March 28, 2010 Share Posted March 28, 2010 Hi Kasra, With my quick testing of the first routine from post #35, I obtain this: [ATTACH]18479[/ATTACH] Thanks a lot. I tested the routine again. I found that if my axis be a polyline, the routine cann't display all distances between two intersections (such as lines and curves) and just display distance between them. Is my conclusion ture? 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.