stevesfr Posted May 30, 2009 Share Posted May 30, 2009 Sorry, my mistake - I was previously testing it with a different block, and accidentally left that name in. Try this: ;; Align Block to Curve ~ by Lee McDonnell (Lee Mac) ;; 29th May 2009 (defun c:PlBlk (/ blkName doc spc cEnt tmp cLen blk) (vl-load-com) (setq blkName "KEY-ITEM") (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) ; Vport (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or *PlBlk:Desc* (setq *PlBlk:Desc* (chr 32))) (or (eq 'STR (type blkName)) (setq blkName "")) (if (or (tblsearch "BLOCK" blkName) (findfile (strcat blkName ".dwg"))) (if (and (setq cEnt (entsel "\nSelect Curve Object: ")) (member (cdr (assoc 0 (entget (car cEnt)))) '("LINE" "POLYLINE" "LWPOLYLINE" "ARC" "SPLINE"))) (progn (setq tmp (getstring t (strcat "\nSpecify Block Description <" (if (eq (chr 32) *PlBlk:Desc*) "-None-" *PlBlk:Desc*) "> : "))) (or (not tmp) (setq *PlBlk:Desc* tmp)) (setq cLen (- (vlax-curve-getDistatParam (car cEnt) (vlax-curve-getEndParam (car cEnt))) (vlax-curve-getDistatParam (car cEnt) (vlax-curve-getStartParam (car cEnt)))) blk (vla-insertBlock spc (vlax-3D-point (cadr cEnt)) (strcat blkName ".dwg") 1. 1. 1. 0.)) (if (eq :vlax-true (vla-get-HasAttributes blk)) (foreach att (vlax-safearray->list (vlax-variant-value (vla-getAttributes blk))) (cond ((eq (vla-get-TagString att) "ITEM") (vla-put-TextString att *PlBlk:Desc*)) ((eq (vla-get-TagString att) "QUANTITY") (vla-put-TextString att (rtos cLen))))) (princ "\n<< Block Has No Attributes to Fill >>")) (lmac-obj-drag-move "Position Block..." blk (vlax-ename->vla-object (car cEnt)) nil)) (princ "\n<< No Curve Object Selected >>")) (princ "\n<< Block Not Found >>")) (princ)) ;; Ghosting Example, by Lee McDonnell (Lee Mac) ;; Args: ;; msg ~ prompt [str] ;; oBj ~ object [ent/obj] ;; hi ~ rubber band [t/nil] (defun lmac-obj-drag-move (msg oBj Cur hi / oBj bsPt gr pt Ang) (vl-load-com) (if msg (prompt (strcat (if (not (vl-string-search "\n" msg)) "\n""") msg))) (or (eq 'VLA-OBJECT (type oBj)) (setq oBj (vlax-ename->vla-object oBj))) (if (vlax-property-available-p oBj 'InsertionPoint) (progn (if hi (setq bsPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint oBj))))) (while (not (eq 3 (car (setq gr (grread 't))))) (redraw) (if (and (eq 5 (car gr)) (listp (cadr gr))) (progn (setq pt (vlax-curve-getClosestPointto Cur (cadr gr)) Ang (angle pt (cadr gr))) (vla-put-Rotation oBj (- Ang (/ pi 2))) (vla-move oBj (vla-get-InsertionPoint oBj) (vlax-3D-point (polar pt Ang (/ (getvar "TEXTSIZE") 2.)))) (if hi (grdraw bsPt (cadr gr) 256 1)))))) nil) (redraw)) Lee, WOW, is this great or what ? THANKS much. A big bucket of Guinness to you my man !! Also your new wacky "star" program (or polygon program) is playful also.... neato !!! I'll start a new thread for the spinoff problem #2 of above code later. I wish there wasn't so much of a time difference between this location and yours (6 hrs). Basically next problem concerns summing like attributes *before* exporting to Excel. Presently I can export attributes to Excel, but each attribute has its own row in the spreadsheet. For example Beer 1 Beer 1 Beer 1 instead of Beer 3 think about it... talk later thanks Steve Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 30, 2009 Share Posted May 30, 2009 Lee,WOW, is this great or what ? THANKS much. A big bucket of Guinness to you my man !! Also your new wacky "star" program (or polygon program) is playful also.... neato !!! I'll start a new thread for the spinoff problem #2 of above code later. I wish there wasn't so much of a time difference between this location and yours (6 hrs). Basically next problem concerns summing like attributes *before* exporting to Excel. Presently I can export attributes to Excel, but each attribute has its own row in the spreadsheet. For example Beer 1 Beer 1 Beer 1 instead of Beer 3 think about it... talk later thanks Steve I'm glad it works for you At the moment, the offset from the curve is just set at half the "TEXTSIZE" variable - but this can be changed if need be - you could have no offset if you wish. Also, obviously the attributes will be rotated as well as the block when moving it around the curve - I could include code to set the attributes back to horizontal, if you wanted. Thanks for the "virtual Beers" - I think I'm becoming an alcoholic with the amount of "virtual beers" that have been bought for me... Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 2, 2009 Share Posted June 2, 2009 I'm glad it works for you At the moment, the offset from the curve is just set at half the "TEXTSIZE" variable - but this can be changed if need be - you could have no offset if you wish. Also, obviously the attributes will be rotated as well as the block when moving it around the curve - I could include code to set the attributes back to horizontal, if you wanted. Thanks for the "virtual Beers" - I think I'm becoming an alcoholic with the amount of "virtual beers" that have been bought for me... Lee, after testing and using it, I think the following revisions are in order whenever you have a minite or two. 1. block and attributes should always be inserted horizontal 2. I think it best that the insertion scale of the block be related to LT scale, (which is related to our plotting at 1"=20, 50, or 100 etc.) 3. FYI, we Never use arch units here 4. insertion point of block can be at the pick point of curve or line, users will quickly catch on or else ! My thanks to the virtual alcoholic ! Steve Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 2, 2009 Share Posted June 2, 2009 This should resolve all issues: ;; Align Block to Curve ~ by Lee McDonnell (Lee Mac) ;; 29th May 2009 (defun c:PlBlk (/ blkName doc spc cEnt tmp cLen blk lt) (vl-load-com) (setq blkName "KEY-ITEM") (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) ; Vport (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or *PlBlk:Desc* (setq *PlBlk:Desc* (chr 32))) (or (eq 'STR (type blkName)) (setq blkName "")) (if (or (tblsearch "BLOCK" blkName) (findfile (strcat blkName ".dwg"))) (if (and (setq cEnt (entsel "\nSelect Curve Object: ")) (member (cdr (assoc 0 (entget (car cEnt)))) '("LINE" "POLYLINE" "LWPOLYLINE" "ARC" "SPLINE"))) (progn (setq tmp (getstring t (strcat "\nSpecify Block Description <" (if (eq (chr 32) *PlBlk:Desc*) "-None-" *PlBlk:Desc*) "> : "))) (or (eq "" tmp) (setq *PlBlk:Desc* tmp)) (setq cLen (- (vlax-curve-getDistatParam (car cEnt) (vlax-curve-getEndParam (car cEnt))) (vlax-curve-getDistatParam (car cEnt) (vlax-curve-getStartParam (car cEnt))))) (or (not (zerop (setq lt (vla-get-LineTypeScale (vlax-ename->vla-object (car cEnt)))))) (setq lt 1.)) (setq blk (vla-insertBlock spc (vlax-3D-point (cadr cEnt)) (strcat blkName ".dwg") lt lt lt 0.)) (if (eq :vlax-true (vla-get-HasAttributes blk)) (foreach att (vlax-safearray->list (vlax-variant-value (vla-getAttributes blk))) (cond ((eq (vla-get-TagString att) "ITEM") (vla-put-TextString att *PlBlk:Desc*)) ((eq (vla-get-TagString att) "QUANTITY") (vla-put-TextString att (rtos cLen))))) (princ "\n<< Block Has No Attributes to Fill >>")) (lmac-obj-drag-move "Position Block..." blk (vlax-ename->vla-object (car cEnt)) nil)) (princ "\n<< No Curve Object Selected >>")) (princ "\n<< Block Not Found >>")) (princ)) ;; Ghosting Example, by Lee McDonnell (Lee Mac) ;; Args: ;; msg ~ prompt [str] ;; oBj ~ object [ent/obj] ;; hi ~ rubber band [t/nil] (defun lmac-obj-drag-move (msg oBj Cur hi / oBj bsPt gr pt Ang) (vl-load-com) (if msg (prompt (strcat (if (not (vl-string-search "\n" msg)) "\n""") msg))) (or (eq 'VLA-OBJECT (type oBj)) (setq oBj (vlax-ename->vla-object oBj))) (if (vlax-property-available-p oBj 'InsertionPoint) (progn (if hi (setq bsPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint oBj))))) (while (not (eq 3 (car (setq gr (grread 't))))) (redraw) (if (and (eq 5 (car gr)) (listp (cadr gr))) (progn (setq pt (vlax-curve-getClosestPointto Cur (cadr gr)) Ang (angle pt (cadr gr))) ;(vla-put-Rotation oBj (- Ang (/ pi 2))) (vla-move oBj (vla-get-InsertionPoint oBj) (vlax-3D-point pt)) (if hi (grdraw bsPt (cadr gr) 256 1)))))) nil) (redraw)) Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 2, 2009 Share Posted June 2, 2009 This should resolve all issues: ;; Align Block to Curve ~ by Lee McDonnell (Lee Mac) ;; 29th May 2009 (defun c:PlBlk (/ blkName doc spc cEnt tmp cLen blk lt) (vl-load-com) (setq blkName "KEY-ITEM") (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) ; Vport (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or *PlBlk:Desc* (setq *PlBlk:Desc* (chr 32))) (or (eq 'STR (type blkName)) (setq blkName "")) (if (or (tblsearch "BLOCK" blkName) (findfile (strcat blkName ".dwg"))) (if (and (setq cEnt (entsel "\nSelect Curve Object: ")) (member (cdr (assoc 0 (entget (car cEnt)))) '("LINE" "POLYLINE" "LWPOLYLINE" "ARC" "SPLINE"))) (progn (setq tmp (getstring t (strcat "\nSpecify Block Description <" (if (eq (chr 32) *PlBlk:Desc*) "-None-" *PlBlk:Desc*) "> : "))) (or (eq "" tmp) (setq *PlBlk:Desc* tmp)) (setq cLen (- (vlax-curve-getDistatParam (car cEnt) (vlax-curve-getEndParam (car cEnt))) (vlax-curve-getDistatParam (car cEnt) (vlax-curve-getStartParam (car cEnt))))) (or (not (zerop (setq lt (vla-get-LineTypeScale (vlax-ename->vla-object (car cEnt)))))) (setq lt 1.)) (setq blk (vla-insertBlock spc (vlax-3D-point (cadr cEnt)) (strcat blkName ".dwg") lt lt lt 0.)) (if (eq :vlax-true (vla-get-HasAttributes blk)) (foreach att (vlax-safearray->list (vlax-variant-value (vla-getAttributes blk))) (cond ((eq (vla-get-TagString att) "ITEM") (vla-put-TextString att *PlBlk:Desc*)) ((eq (vla-get-TagString att) "QUANTITY") (vla-put-TextString att (rtos cLen))))) (princ "\n<< Block Has No Attributes to Fill >>")) (lmac-obj-drag-move "Position Block..." blk (vlax-ename->vla-object (car cEnt)) nil)) (princ "\n<< No Curve Object Selected >>")) (princ "\n<< Block Not Found >>")) (princ)) ;; Ghosting Example, by Lee McDonnell (Lee Mac) ;; Args: ;; msg ~ prompt [str] ;; oBj ~ object [ent/obj] ;; hi ~ rubber band [t/nil] (defun lmac-obj-drag-move (msg oBj Cur hi / oBj bsPt gr pt Ang) (vl-load-com) (if msg (prompt (strcat (if (not (vl-string-search "\n" msg)) "\n""") msg))) (or (eq 'VLA-OBJECT (type oBj)) (setq oBj (vlax-ename->vla-object oBj))) (if (vlax-property-available-p oBj 'InsertionPoint) (progn (if hi (setq bsPt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint oBj))))) (while (not (eq 3 (car (setq gr (grread 't))))) (redraw) (if (and (eq 5 (car gr)) (listp (cadr gr))) (progn (setq pt (vlax-curve-getClosestPointto Cur (cadr gr)) Ang (angle pt (cadr gr))) ;(vla-put-Rotation oBj (- Ang (/ pi 2))) (vla-move oBj (vla-get-InsertionPoint oBj) (vlax-3D-point pt)) (if hi (grdraw bsPt (cadr gr) 256 1)))))) nil) (redraw)) LEE, I guess I wasn't clear on the block insertion scale issue. I meant that the block insertion scale should find the "ltscale" setting from the drawing into which it is being inserted. As it is now the "lt" in the program is moot. Present code inserts the block at scale of 1,1,0 Of course user could rescale all of the "key-item" blocks, but auto would be great. Love what has been helped along so far......... VA. ! Steve Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 2, 2009 Share Posted June 2, 2009 Steve, this code gets the linetypescale from whatever line you select, and uses it (unless it is zero - then it uses 1.) Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 2, 2009 Share Posted June 2, 2009 Steve, this code gets the linetypescale from whatever line you select, and uses it (unless it is zero - then it uses 1.) as an example, I have LTSCALE set at 50 , but block is being inserted at scale of 1,1 block is not finding proper scale of drawing. see if you can get block to be inserted greater than 1,1 Quote Link to comment Share on other sites More sharing options...
stevesfr Posted June 2, 2009 Share Posted June 2, 2009 Steve, this code gets the linetypescale from whatever line you select, and uses it (unless it is zero - then it uses 1.) Lee, you are correct........ pilot error on my part. all is well after setting proper ltscale for line under consideration. Fishing here without a baited hook......... caught something after putting new bait on hook !!!!!!!!!!!!!!! later and thanks Steve Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 2, 2009 Share Posted June 2, 2009 OK, glad you got it sorted - if you need any other modifications done, let me know mate, Cheers, Lee Quote Link to comment Share on other sites More sharing options...
himal Posted May 26, 2012 Share Posted May 26, 2012 Thanks Mac great job Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 27, 2012 Share Posted May 27, 2012 A very old thread with some very old code, but you're welcome himal Quote Link to comment Share on other sites More sharing options...
BADAVATERAJ Posted November 12, 2012 Share Posted November 12, 2012 The lisp looks OK but? Can U Please make it more advanced like selecting all pline and getting the length text on those plines like pdim. it will be gr8 if u do it for me thanks in advance RAJ... Quote Link to comment Share on other sites More sharing options...
ReMark Posted November 12, 2012 Share Posted November 12, 2012 What good will a lisp routine do you if your program is in fact AutoCAD LT? LT cannot make use of lisp. Quote Link to comment Share on other sites More sharing options...
kenboldt Posted June 17, 2013 Share Posted June 17, 2013 Give this a shot [Length to 2 dp.] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:plLen [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] cEnt tStr tBox tHgt tWid gr sPt cPt lAng bPt tPt pt1 pt2 pt3 pt4[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cEnt [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Object: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]member[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]0[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] cEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#ff00ff]"LWPOLYLINE"[/color][/b] [b][color=#ff00ff]"POLYLINE"[/color][/b] [b][color=#ff00ff]"LINE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] tStr [b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-length[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] cEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]2[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b] tBox [b][color=RED]([/color][/b][b][color=BLUE]textbox[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]1[/color][/b] tStr[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]40[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] tHgt [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadadr[/color][/b] tBox[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cadar[/color][/b] tBox[b][color=RED])[/color][/b][b][color=RED])[/color][/b] twid [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caadr[/color][/b] tBox[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]caar[/color][/b] tBox[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\nPosition Text..."[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]5[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] gr [b][color=RED]([/color][/b][b][color=BLUE]grread[/color][/b] [b][color=BLUE]t[/color][/b] [b][color=#009900]5[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]redraw[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]listp[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] sPt [b][color=RED]([/color][/b][b][color=BLUE]cadr[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cPt [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getClosestPointto[/color][/b] cEnt sPt[b][color=RED])[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]angle[/color][/b] cPt sPt[b][color=RED])[/color][/b] bpt [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] cPt lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=RED])[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] tpt [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] bpt lAng tHgt[b][color=RED])[/color][/b] mPt [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] bPt lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tHgt [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] pt1 [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] bpt [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] pt2 [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] bPt [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] pt3 [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] tpt [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] pt4 [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] tPt [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] tWid [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]grvecs[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=#009900]-3[/color][/b] pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#009900]3[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] gr[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009999]2.[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cond[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=BLUE]pi[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] lAng [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] lAng [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] lAng [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]*[/color][/b] [b][color=#009900]3[/color][/b] [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lAng [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] lAng [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]Make_Text mPt tStr lAng[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n<!> Incorrect Selection <!>"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]redraw[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] Make_Text [b][color=RED]([/color][/b]pt val rot[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entmake[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#ff00ff]"TEXT"[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]8[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"CLAYER"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]62[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]10[/color][/b] pt[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]40[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TEXTSIZE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]1[/color][/b] val[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]50[/color][/b] rot[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]7[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getvar[/color][/b] [b][color=#ff00ff]"TEXTSTYLE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]71[/color][/b] [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]72[/color][/b] [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]73[/color][/b] [b][color=#009900]2[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]11[/color][/b] pt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Sorry to dig up an old post, but I was wondering if there was any way to modify the above lisp so that it gives you the segment length, not the total length of the polyline. Thanks in advance for any help anyone can provide. Quote Link to comment Share on other sites More sharing options...
ReMark Posted June 17, 2013 Share Posted June 17, 2013 This lisp routine will give you polyline segment lengths along with other information. http://lee-mac.com/polyinfo.html Quote Link to comment Share on other sites More sharing options...
Yasir-Aman Posted June 2, 2015 Share Posted June 2, 2015 Give this a shot [Length to 2 dp.] [b][color=RED][b][color=BLUE]defun[/color][/b] c:plLen.....[/color][/b] Salam LM, I was recently looking for a lisp to print the length of each "individual Line" or "Polyline" above it in the form of "Text" (not Mtext). After three days of searching, I came across this code by you and it works like a charm (thanks to you). Now I am being greedy to have some more functionality in it It would be so nice if you can help out. How can I change the text height from 2 to something else? How can I snap to Mid point or any other point during "position the text"? Hope I am not too late to demand help Thank you in advance for consideration --yasir Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 2, 2015 Share Posted June 2, 2015 Hi Yasir, I'm pleased to hear that you find this old program useful Before I consider modifying this old code, I would first suggest that you perhaps try my more recent Length at Midpoint program - this program will automatically generate the length measurement at the midpoint of the selected object(s); as for the text height, this will be dictated by the value of the TEXTSIZE system variable in your drawing. Lee Quote Link to comment Share on other sites More sharing options...
Yasir-Aman Posted June 2, 2015 Share Posted June 2, 2015 (edited) Hi Yasir, I'm pleased to hear that you find this old program useful Before I consider modifying this old code, I would first suggest that you perhaps try my more recent Length at Midpoint program - this program will automatically generate the length measurement at the midpoint of the selected object(s); as for the text height, this will be dictated by the value of the TEXTSIZE system variable in your drawing. Lee Salam Lee, First of all, thank you so much for your reply. I was really not expecting such a quick response on the same day of my post. As for as your suggestion is concerned, I just tried your "midlen" code. It indeed is a very useful lisp, BUT, this particular case - which I am dealing with - demands something that I already mentioned in my first post. Plz consider: 1- I need only and only "text" object, NOT mtext. 2- It must be "pure" text object, WITHOUT field inside the text. 3- It must be WITHOUT background mask. 4- It must be placed "above/below" the object, NOT ON the object. 5- It will be extremely helpful to have the "snap" working, so that the text can be manually positioned as desired. Keeping in view all these requirements, the old code seems very near to my needed lisp. Humble suggestion: By mixing the old code with the "midlen" code, or just adding a few lines of code to the old code, you will be able to provide me a lisp that: 1- Basically produces "text" object, but includes commented code for "mtext" which can be "un-commented" and used to produce mtext when needed. 2- Basically produces text/mtext without any mask, but includes commented code for "background mask" which can be "un-commented" and used to produce text/mtext with backround mask when needed. 3- Produces text with default text height of 1 (without following TEXTSIZE system variable). And whenever I want to change the text height, I can change the value within the lisp code and reload it, OR there can be an option included in the command which can accept new text height value when needed. For example: Select objects or [text Height/text Rotation]: Thank you so much once again. I hope I am not bothering you too much. Regards; --Yasir Edited June 2, 2015 by Yasir-Aman bad grammar :P Quote Link to comment Share on other sites More sharing options...
mousho Posted December 1, 2016 Share Posted December 1, 2016 Dear Lee Mac regarding Post #11 the lisp currently offers me to place the text anywhere on the circumference of the shape. i would like the placement to be set to the bottom left-hand corner always(without being asked where to place it) in addition i would like the number to always be rounded to the nearest 5cm how is this possible? Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 1, 2016 Share Posted December 1, 2016 Lee, I'd like to order a large peperoni pizza with extra cheese. Is this possible? the irony 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.