woohhoo Posted April 21, 2010 Posted April 21, 2010 Hi, can someone help me? I don't no anything about autolisp and I need a routine that can autonumber and also take the length of a polyne in one time. I also need the possibility of entering a startnumber. And if it's also possible too, the number and length of the polyline must be placed above and in the middle of the polyline. Thanks. Quote
Lee Mac Posted April 21, 2010 Posted April 21, 2010 Would this help? http://www.cadtutor.net/forum/showthread.php?t=35234 Quote
woohhoo Posted April 21, 2010 Author Posted April 21, 2010 Hey Lee Mac, thanks for the lisp. It's almost what I need. Concerning the autonumbering and alignment it's perfect but I still miss the length of the polyline. See image for more info. Again thanks for the help. Quote
Lee Mac Posted April 21, 2010 Posted April 21, 2010 Give this a shot, it uses Fields: (defun c:PLen ( / *error* doc spc ent uFlag tStr ) (vl-load-com) ;; Lee Mac ~ 21.04.10 (defun *error* (msg) (and uFlag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc)) (eq :vlax-true (vla-get-MSpace doc))) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc))) (setq *num (cond ( *num ) ( 1 )) *num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : "))) (*num)))) (while (setq ent (CurveifFoo (lambda (ent) (and (isCurveObject ent) (vlax-property-available-p (vlax-ename->vla-object ent) 'Length))) (strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : "))) (setq uFlag (not (vla-StartUndoMark doc)) tStr (strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId " (GetObjectID (vlax-ename->vla-object ent)) ">%).Length \\f \"%lu6\>%")) (AlignObjtoCurve (MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE)) (setq uFlag (vla-EndUndoMark doc))) (princ)) (defun GetObjectID ( obj ) (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE"))) (vlax-invoke-method (vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object))) 'GetObjectIdString obj :vlax-false) (itoa (vla-get-Objectid obj)))) (defun MCMText (block point width string / o) (vla-put-AttachmentPoint (setq o (vla-AddMText block (vlax-3D-point point) width string)) acAttachmentPointMiddleCenter) o) (defun isCurveObject (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam) (list ent))))) (defun CurveifFoo ( foo str / sel ent ) (while (progn (setq sel (entsel str)) (cond ( (vl-consp sel) (if (not (foo (setq ent (car sel)))) (princ "\n** Invalid Object Selected **")))))) ent) (defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng ) (vl-load-com) (defun *error* (msg) (and obj (not (vlax-erased-p obj)) (vla-delete obj)) (and uFlag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (or *Mac$Per* (setq *Mac$Per* (/ pi 2.))) (or *Mac$Off* (setq *Mac$Off* 1.)) (setq msg (princ "\n<< [+/-] for offset, [P]erpendicularity toggle >>")) (while (progn (setq gr (grread 't 15 0) code (car gr) data (cadr gr)) (cond ( (and (= 5 code) (listp data)) (setq pt (vlax-curve-getClosestPointto ent data) cAng (angle pt data) lAng (+ cAng *Mac$Per*)) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-put-InsertionPoint Obj (vlax-3D-point (polar pt cAng (* o *Mac$Off*)))) (vla-put-Rotation Obj lAng) t) ( (= 2 code) (cond ( (vl-position data '(43 61)) (setq *Mac$Off* (+ *Mac$Off* 0.1))) ( (= 45 data) (setq *Mac$Off* (- *Mac$Off* 0.1))) ( (vl-position data '(80 112)) (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*))) ( (vl-position data '(13 32)) (setq Obj nil)) (t ))) ( (and (= 3 code) (listp data)) (setq pt (vlax-curve-getClosestPointto ent data) cAng (angle pt data) lAng (+ cAng *Mac$Per*)) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-put-InsertionPoint Obj (vlax-3D-point (polar pt cAng (* o *Mac$Off*)))) (vla-put-Rotation Obj lAng) (setq Obj nil)) ( (= 25 code) (setq Obj nil)) (t )))) data) Perhaps look at this also: http://www.cadtutor.net/forum/showthread.php?t=42426 Quote
stevesfr Posted April 21, 2010 Posted April 21, 2010 Give this a shot, it uses Fields: (defun c:PLen ( / *error* doc spc ent uFlag tStr ) (vl-load-com) ;; Lee Mac ~ 21.04.10 (defun *error* (msg) (and uFlag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc)) (eq :vlax-true (vla-get-MSpace doc))) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc))) (setq *num (cond ( *num ) ( 1 )) *num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : "))) (*num)))) (while (setq ent (CurveifFoo (lambda (ent) (and (isCurveObject ent) (vlax-property-available-p (vlax-ename->vla-object ent) 'Length))) (strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : "))) (setq uFlag (not (vla-StartUndoMark doc)) tStr (strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId " (GetObjectID (vlax-ename->vla-object ent)) ">%).Length \\f \"%lu6\>%")) (AlignObjtoCurve (MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE)) (setq uFlag (vla-EndUndoMark doc))) (princ)) (defun GetObjectID ( obj ) (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE"))) (vlax-invoke-method (vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object))) 'GetObjectIdString obj :vlax-false) (itoa (vla-get-Objectid obj)))) (defun MCMText (block point width string / o) (vla-put-AttachmentPoint (setq o (vla-AddMText block (vlax-3D-point point) width string)) acAttachmentPointMiddleCenter) o) (defun isCurveObject (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam) (list ent))))) (defun CurveifFoo ( foo str / sel ent ) (while (progn (setq sel (entsel str)) (cond ( (vl-consp sel) (if (not (foo (setq ent (car sel)))) (princ "\n** Invalid Object Selected **")))))) ent) (defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng ) (vl-load-com) (defun *error* (msg) (and obj (not (vlax-erased-p obj)) (vla-delete obj)) (and uFlag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (or *Mac$Per* (setq *Mac$Per* (/ pi 2.))) (or *Mac$Off* (setq *Mac$Off* 1.)) (setq msg (princ "\n<< [+/-] for offset, [P]erpendicularity toggle >>")) (while (progn (setq gr (grread 't 15 0) code (car gr) data (cadr gr)) (cond ( (and (= 5 code) (listp data)) (setq pt (vlax-curve-getClosestPointto ent data) cAng (angle pt data) lAng (+ cAng *Mac$Per*)) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-put-InsertionPoint Obj (vlax-3D-point (polar pt cAng (* o *Mac$Off*)))) (vla-put-Rotation Obj lAng) t) ( (= 2 code) (cond ( (vl-position data '(43 61)) (setq *Mac$Off* (+ *Mac$Off* 0.1))) ( (= 45 data) (setq *Mac$Off* (- *Mac$Off* 0.1))) ( (vl-position data '(80 112)) (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*))) ( (vl-position data '(13 32)) (setq Obj nil)) (t ))) ( (and (= 3 code) (listp data)) (setq pt (vlax-curve-getClosestPointto ent data) cAng (angle pt data) lAng (+ cAng *Mac$Per*)) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-put-InsertionPoint Obj (vlax-3D-point (polar pt cAng (* o *Mac$Off*)))) (vla-put-Rotation Obj lAng) (setq Obj nil)) ( (= 25 code) (setq Obj nil)) (t )))) data) Lee, is it possible to also pick up the length of an arc ? (just wondering how to do it ?) S Quote
stevesfr Posted April 21, 2010 Posted April 21, 2010 Give this a shot, it uses Fields: (defun c:PLen ( / *error* doc spc ent uFlag tStr ) (vl-load-com) ;; Lee Mac ~ 21.04.10 (defun *error* (msg) (and uFlag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc)) (eq :vlax-true (vla-get-MSpace doc))) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc))) (setq *num (cond ( *num ) ( 1 )) *num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : "))) (*num)))) (while (setq ent (CurveifFoo (lambda (ent) (and (isCurveObject ent) (vlax-property-available-p (vlax-ename->vla-object ent) 'Length))) (strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : "))) (setq uFlag (not (vla-StartUndoMark doc)) tStr (strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId " (GetObjectID (vlax-ename->vla-object ent)) ">%).Length \\f \"%lu6\>%")) (AlignObjtoCurve (MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE)) (setq uFlag (vla-EndUndoMark doc))) (princ)) (defun GetObjectID ( obj ) (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE"))) (vlax-invoke-method (vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object))) 'GetObjectIdString obj :vlax-false) (itoa (vla-get-Objectid obj)))) (defun MCMText (block point width string / o) (vla-put-AttachmentPoint (setq o (vla-AddMText block (vlax-3D-point point) width string)) acAttachmentPointMiddleCenter) o) (defun isCurveObject (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam) (list ent))))) (defun CurveifFoo ( foo str / sel ent ) (while (progn (setq sel (entsel str)) (cond ( (vl-consp sel) (if (not (foo (setq ent (car sel)))) (princ "\n** Invalid Object Selected **")))))) ent) (defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng ) (vl-load-com) (defun *error* (msg) (and obj (not (vlax-erased-p obj)) (vla-delete obj)) (and uFlag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (or *Mac$Per* (setq *Mac$Per* (/ pi 2.))) (or *Mac$Off* (setq *Mac$Off* 1.)) (setq msg (princ "\n<< [+/-] for offset, [P]erpendicularity toggle >>")) (while (progn (setq gr (grread 't 15 0) code (car gr) data (cadr gr)) (cond ( (and (= 5 code) (listp data)) (setq pt (vlax-curve-getClosestPointto ent data) cAng (angle pt data) lAng (+ cAng *Mac$Per*)) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-put-InsertionPoint Obj (vlax-3D-point (polar pt cAng (* o *Mac$Off*)))) (vla-put-Rotation Obj lAng) t) ( (= 2 code) (cond ( (vl-position data '(43 61)) (setq *Mac$Off* (+ *Mac$Off* 0.1))) ( (= 45 data) (setq *Mac$Off* (- *Mac$Off* 0.1))) ( (vl-position data '(80 112)) (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*))) ( (vl-position data '(13 32)) (setq Obj nil)) (t ))) ( (and (= 3 code) (listp data)) (setq pt (vlax-curve-getClosestPointto ent data) cAng (angle pt data) lAng (+ cAng *Mac$Per*)) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-put-InsertionPoint Obj (vlax-3D-point (polar pt cAng (* o *Mac$Off*)))) (vla-put-Rotation Obj lAng) (setq Obj nil)) ( (= 25 code) (setq Obj nil)) (t )))) data) Lee, is it possible to also pick up the length of an arc ? (just wondering how to do it ?) S Lee, spoke too soon, (sorry) it works if arc is drawn with pline and not with "arc" command ! cheers thx for neat program S Quote
Lee Mac Posted April 21, 2010 Posted April 21, 2010 It currently uses the Length field - I could modify it to use ArcLength/Circumference - it just needs a few more conditionals. Quote
alanjt Posted April 21, 2010 Posted April 21, 2010 Label each segment with number and distance... (defun c:PLab (/ obj) ;; Label each LWPolyline segment with number and distance ;; Alan J. Thompson, 04.21.10 (if (and (setq obj (car (entsel "\nSelect LWPolyline: "))) (or (eq "LWPOLYLINE" (cdr (assoc 0 (entget obj)))) (alert "Invalid object!") ) (setq obj (vlax-ename->vla-object obj)) ) ((lambda (n l / a b) (while (nth (1+ (setq n (1+ n))) l) (progn (vla-put-rotation (AT:MText (vlax-3d-point (vlax-curve-GetClosestPointTo obj (mapcar (function (lambda (x y) (/ (+ x y) 2.))) (setq a (nth n l)) (setq b (nth (1+ n) l)) ) ) ) (strcat (itoa (1+ n)) " - " (rtos (abs (- (vlax-curve-getDistAtPoint obj a) (vlax-curve-getDistAtPoint obj b) ) ) ) ) 0. nil 8 ) (angle a b) ) ) ) ) -1 (AT:ListGroupByNumber (vlax-get obj 'Coordinates) 2) ) ) (princ) ) ;;; Add MText to drawing ;;; Pt - MText insertion point ;;; Str - String to place in created MText object ;;; Wd - Width of MText object (if nil, will be 0 width) ;;; Lay - Layer to place Mtext object on (nil for current) ;;; Jus - Justification # for Mtext object ;;; 1 or nil= TopLeft ;;; 2= TopCenter ;;; 3= TopRight ;;; 4= MiddleLeft ;;; 5= MiddleCenter ;;; 6= MiddleRight ;;; 7= BottomLeft ;;; 8= BottomCenter ;;; 9= BottomRight ;;; Alan J. Thompson, 05.23.09 / 04.09.10 (defun AT:MText (Pt Str Wd Lay Jus / Wd s o) (or Wd (setq Wd 0.)) (setq s (if (or (eq acmodelspace (vla-get-activespace (cond (*AcadDoc*) ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))) ) ) ) (eq :vlax-true (vla-get-mspace *AcadDoc*)) ) (vla-get-modelspace *AcadDoc*) (vla-get-paperspace *AcadDoc*) ) Pt (cond ((vl-consp Pt) (vlax-3d-point Pt)) ((eq (type Pt) 'variant) Pt) ) ) (setq o (vla-addMText s Pt Wd (vl-princ-to-string Str))) (and Lay (tblsearch "layer" Lay) (vla-put-layer o Lay)) (cond ((vl-position Jus '(1 2 3 4 5 6 7 8 9)) (vla-put-AttachmentPoint o Jus) (vla-put-InsertionPoint o Pt) ) ) o ) ;;; Group items in list based on specified number ;;; L - List to process ;;; # - Number of items for grouping ;;; Alan J. Thompson, 03.26.10 (defun AT:ListGroupByNumber (L # / n g f) (setq n -1) (while (> (1- (length L)) n) (repeat # (setq g (cons (nth (setq n (1+ n)) L) g))) (setq f (cons (reverse g) f) g nil ) ;_ setq ) ;_ while (reverse f) ) ;_ defun Quote
Lee Mac Posted April 21, 2010 Posted April 21, 2010 Updated to include Circles and Arcs (defun c:PLen ( / *error* doc spc ent obj uFlag tStr ) (vl-load-com) ;; Lee Mac ~ 21.04.10 (defun *error* (msg) (and uFlag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc)) (eq :vlax-true (vla-get-MSpace doc))) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc))) (setq *num (cond ( *num ) ( 1 )) *num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : "))) (*num)))) (while (setq ent (CurveifFoo (lambda (ent) (and (isCurveObject ent) (vl-some (function (lambda ( property ) (vlax-property-available-p (vlax-ename->vla-object ent) property))) '(Length ArcLength Circumference)))) (strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : "))) (setq uFlag (not (vla-StartUndoMark doc)) tStr (strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId " (GetObjectID (setq obj (vlax-ename->vla-object ent))) ">%)." (vl-some (function (lambda ( property ) (if (vlax-property-available-p obj (read property)) property))) '("Length" "ArcLength" "Circumference")) " \\f \"%lu6\>%")) (AlignObjtoCurve (MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE)) (setq uFlag (vla-EndUndoMark doc))) (princ)) (defun GetObjectID ( obj ) (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE"))) (vlax-invoke-method (vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object))) 'GetObjectIdString obj :vlax-false) (itoa (vla-get-Objectid obj)))) (defun MCMText (block point width string / o) (vla-put-AttachmentPoint (setq o (vla-AddMText block (vlax-3D-point point) width string)) acAttachmentPointMiddleCenter) o) (defun isCurveObject (ent) (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getEndParam) (list ent))))) (defun CurveifFoo ( foo str / sel ent ) (while (progn (setq sel (entsel str)) (cond ( (vl-consp sel) (if (not (foo (setq ent (car sel)))) (princ "\n** Invalid Object Selected **")))))) ent) (defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng ) (vl-load-com) (defun *error* (msg) (and obj (not (vlax-erased-p obj)) (vla-delete obj)) (and uFlag (vla-EndUndoMark doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (or *Mac$Per* (setq *Mac$Per* (/ pi 2.))) (or *Mac$Off* (setq *Mac$Off* 1.)) (setq msg (princ "\n<< [+/-] for offset, [P]erpendicularity toggle >>")) (while (progn (setq gr (grread 't 15 0) code (car gr) data (cadr gr)) (cond ( (and (= 5 code) (listp data)) (setq pt (vlax-curve-getClosestPointto ent data) cAng (angle pt data) lAng (+ cAng *Mac$Per*)) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-put-InsertionPoint Obj (vlax-3D-point (polar pt cAng (* o *Mac$Off*)))) (vla-put-Rotation Obj lAng) t) ( (= 2 code) (cond ( (vl-position data '(43 61)) (setq *Mac$Off* (+ *Mac$Off* 0.1))) ( (= 45 data) (setq *Mac$Off* (- *Mac$Off* 0.1))) ( (vl-position data '(80 112)) (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*))) ( (vl-position data '(13 32)) (setq Obj nil)) (t ))) ( (and (= 3 code) (listp data)) (setq pt (vlax-curve-getClosestPointto ent data) cAng (angle pt data) lAng (+ cAng *Mac$Per*)) (cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-put-InsertionPoint Obj (vlax-3D-point (polar pt cAng (* o *Mac$Off*)))) (vla-put-Rotation Obj lAng) (setq Obj nil)) ( (= 25 code) (setq Obj nil)) (t )))) data) Quote
alanjt Posted April 22, 2010 Posted April 22, 2010 I guess I read the request wrong. I was thinking the ability to label each segment length was the desired result. Oh well, it was fun to put together and I might have a use for it (minus the numbering). Good stuff Lee. Quote
woohhoo Posted April 22, 2010 Author Posted April 22, 2010 Lee, it's awesome!! That's exactly what I was looking for. Thanks! Quote
Lee Mac Posted April 22, 2010 Posted April 22, 2010 You're welcome I like to use the dynamic approach when placing text, as it gives you a proper preview of what you are about to place. The only drawback to this method is that you don't have any AutoCAD functionality such as OSnap, Ortho, Tracking etc. But I figure most do not use such that regularly to place text. Lee Quote
asos2000 Posted April 23, 2010 Posted April 23, 2010 Alanjt see attached image and cad file plab.dwg Quote
alanjt Posted April 23, 2010 Posted April 23, 2010 Alanjt see attached image and cad file Ahh, the woes of vlax-curve-getClosestPointTo and not properly considering it's obvious constraints. Try it now (also removed the need for the AT:MText subroutine since I was defining the ActiveSpace for each text object. (defun c:PLab (/ obj) ;; Label each LWPolyline segment with number and distance ;; Alan J. Thompson, 04.21.10 / 04.23.10 (vl-load-com) (if (and (setq obj (car (entsel "\nSelect LWPolyline: "))) (or (eq "LWPOLYLINE" (cdr (assoc 0 (entget obj)))) (alert "Invalid object!") ) (setq obj (vlax-ename->vla-object obj)) ) ((lambda (n l s / d) (while (nth (1+ (setq n (1+ n))) l) ((lambda (a b / dist) (setq dist (abs (- (setq d (vlax-curve-getDistAtPoint obj a)) (vlax-curve-getDistAtPoint obj b) ) ) ) ((lambda (p) ((lambda (text) (vla-put-AttachmentPoint text (vla-put-InsertionPoint text p) ;; (vla-put-Rotation text (angle a b)) ((lambda (ang) (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5))) (vla-put-rotation text (+ pi ang)) (vla-put-rotation text ang) ) ) (angle a b) ) ) (vla-AddMText s p 0. (strcat (itoa (1+ n)) " - " (rtos dist))) ) ) (vlax-3d-point (vlax-curve-getPointAtDist obj (+ (/ dist 2.) d))) ) ) (nth n l) (nth (1+ n) l) ) ) ) -1 (AT:ListGroupByNumber (vlax-get obj 'Coordinates) 2) (if (or (eq acmodelspace (vla-get-activespace (cond (*AcadDoc*) ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))) ) ) ) (eq :vlax-true (vla-get-mspace *AcadDoc*)) ) (vla-get-modelspace *AcadDoc*) (vla-get-paperspace *AcadDoc*) ) ) ) (princ) ) ;;; Group items in list based on specified number ;;; L - List to process ;;; # - Number of items for grouping ;;; Alan J. Thompson, 03.26.10 (defun AT:ListGroupByNumber (L # / n g f) (setq n -1) (while (> (1- (length L)) n) (repeat # (setq g (cons (nth (setq n (1+ n)) L) g))) (setq f (cons (reverse g) f) g nil ) ;_ setq ) ;_ while (reverse f) ) ;_ defun Quote
alanjt Posted April 24, 2010 Posted April 24, 2010 I think Alan's gone lambda mad ROFL I did let them get a little out of control. Ever since you did that Boundingbox routine modeled after MP's code, I've been loving and abusing lambda outside of the use of mapcar (or defining as functions like I've been known to do) like a mad man. I mean, look at this: (([color=Red]lambda[/color] (n l s / d) (while (nth (1+ (setq n (1+ n))) l) (([color=Red]lambda [/color](a b / dist) (setq dist (abs (- (setq d (vlax-curve-getDistAtPoint obj a)) (vlax-curve-getDistAtPoint obj b) ) ) ) (([color=Red]lambda [/color](p) (([color=Red]lambda [/color](text) (vla-put-AttachmentPoint text (vla-put-InsertionPoint text p) ;; (vla-put-Rotation text (angle a b)) (([color=Red]lambda [/color](ang) 5 lambda expressions You know, I'm surprised you haven't commented on my abandonment of end line comments and #Variable assigning. BTW/off topic: I got a 96 on my Trig test (final Monday) and 2 of those points were taken off because I forgot to denote my units on a problem. If you hadn't answered my questions, I would have been completely lost on that section. Thanks a lot. Quote
Lee Mac Posted April 25, 2010 Posted April 25, 2010 BTW/off topic: I got a 96 on my Trig test (final Monday) and 2 of those points were taken off because I forgot to denote my units on a problem. If you hadn't answered my questions, I would have been completely lost on that section. Thanks a lot. No worries mate, glad it went well for you Quote
gordon_Gjs Posted April 29, 2010 Posted April 29, 2010 Lee Mac the PLen lisp works great for what I am wanting, but would it be possible to have one that would... Not to do auto numbering. The total length value gets inserted automatically in the center/midpoint of the polyline. I would like to go for speed when finding the length of each polyline. If it could be possible I would like to be able to select all polylines and have all the values insert themselvs automatically on each individual polyline. Thanks agian and hopes its not asking too much. Quote
Lee Mac Posted April 29, 2010 Posted April 29, 2010 Hi Gordon, Give this a shot, let me know how you get on (using FIELDS), [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:PlL [b][color=RED]([/color][/b] [b][color=BLUE]/[/color][/b] *error* spc i ss e Der p obj [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b] [i][color=#990099];; Lee Mac ~ 29.04.10[/color][/i] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] *error* [b][color=RED]([/color][/b] msg [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]wcmatch[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] msg[b][color=RED])[/color][/b] [b][color=#a52a2a]"*BREAK,*CANCEL*,*EXIT*"[/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=BLUE]strcat[/color][/b] [b][color=#a52a2a]"\n** Error: "[/color][/b] msg [b][color=#a52a2a]" **"[/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=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] spc [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]or[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [color=Blue][b]AcModelSpace[/b][/color] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveSpace[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] doc [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-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=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=Blue]:vlax-true[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-MSpace[/color][/b] doc[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ModelSpace[/color][/b] doc[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-PaperSpace[/color][/b] doc[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]setq[/color][/b] i [b][color=#009900]-1[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#a52a2a]"LINE,*POLYLINE"[/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]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] i[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]setq[/color][/b] Der [b][color=RED]([/color][/b][b][color=BLUE]angle[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=#009999]0.[/color][/b] [b][color=#009999]0.[/color][/b] [b][color=#009999]0.[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getFirstDeriv[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getParamatPoint[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] p [b][color=RED]([/color][/b]MidPoint e[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=RED]([/color][/b][b][color=BLUE]setq[/color][/b] Obj [b][color=RED]([/color][/b]MCMText spc [b][color=RED]([/color][/b][b][color=BLUE]polar[/color][/b] p [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] Der [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]getvar[/color][/b] [b][color=DARKRED]'[/color][/b]TEXTSIZE[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=#009999]0.[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#a52a2a]"%<\\AcObjProp Object(%<\\_ObjId "[/color][/b] [b][color=RED]([/color][/b]GetObjectID [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] e[b][color=RED])[/color][/b] doc[b][color=RED])[/color][/b] [b][color=#a52a2a]">%).Length \\f \"[/color][color=#a52a2a]%lu6\[/color][/b][b][color=#a52a2a]">%"[/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]vla-put-rotation[/color][/b] Obj [b][color=RED]([/color][/b]MakeReadable Der[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=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] MCMText [b][color=RED]([/color][/b]block point width string [b][color=BLUE]/[/color][/b] o[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-put-AttachmentPoint[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] o [b][color=RED]([/color][/b][b][color=BLUE]vla-AddMText[/color][/b] block [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] point[b][color=RED])[/color][/b] width string[b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=Blue]acAttachmentPointMiddleCenter[/color][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-put-InsertionPoint[/color][/b] o [b][color=RED]([/color][/b][b][color=BLUE]vlax-3D-point[/color][/b] point[b][color=RED])[/color][/b][b][color=RED])[/color][/b] o[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] MakeReadable [b][color=RED]([/color][/b] a [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] a [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] a [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] a [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=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] a [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<=[/color][/b] a [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]+[/color][/b] a [b][color=BLUE]pi[/color][/b][b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b] a [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] GetObjectID [b][color=RED]([/color][/b] obj doc [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=#a52a2a]"X64"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]getenv[/color][/b] [b][color=#a52a2a]"PROCESSOR_ARCHITECTURE"[/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]vlax-invoke-method[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Utility[/color][/b] doc[b][color=RED])[/color][/b] [b][color=DARKRED]'[/color][/b]GetObjectIdString obj [b][color=Blue]:vlax-false[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Objectid[/color][/b] obj[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]defun[/color][/b] MidPoint [b][color=RED]([/color][/b] e [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getPointatDist[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]-[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getDistatPoint[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getEndPoint[/color][/b] e[b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getDistatPoint[/color][/b] e [b][color=RED]([/color][/b][b][color=BLUE]vlax-curve-getStartPoint[/color][/b] e[b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=#009999]2.[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] [b][color=RED])[/color][/b] 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.