sakinen Posted June 24, 2010 Share Posted June 24, 2010 I need a lisp routine for extracting polyline length (selected one) and that value needs to be copied into block attribute (i also need to select one). I have a lisp routine witch does similar job. It measures lenghts and sum of them puts in an attribute. Heres the code: (defun c:MacDis (/ scl pt lst dis dLst grdata gr dat ent) (vl-load-com) (setq scl 1.) (if (setq pt (getpoint "\nSelect Point: ")) (progn (setq lst (cons pt lst)) (while (progn (initget "Scale") (setq pt (getpoint (car lst) "\nSelect Point [scale]: ")) (cond ((eq 'LIST (type pt)) (setq dis (distance pt (car lst)) lst (cons pt lst) dLst (cons (* scl dis) dLst)) (princ (strcat "\n<{:: Distance: " (rtos dis) (if (= scl 1.) "" (strcat " :: After Scaling: " (rtos (* scl dis)))) " :: Total: " (rtos (apply '+ dLst)) " ::}>")) t) ((eq "Scale" pt) (initget 6) (or (setq scl (getreal "\nSpecify Scale Factor <1.0>: ")) (setq scl 1.))) (t nil)))) (if (and dLst (setq msg (princ "\nSelect Attribute: "))) (while (progn (setq grdata (grread 't 13 2) gr (car grdata) dat (cadr grdata)) (cond ((and (eq 3 gr) (listp dat)) (if (and (setq ent (car (nentselp dat))) (eq "ATTRIB" (cdr (assoc 0 (entget ent))))) (vla-put-TextString (vlax-ename->vla-object ent) (rtos (apply '+ dLst))) (princ (strcat "\n** Object Not an Attribute **" msg)))) ((or (eq 25 gr) (and (eq 2 gr) (vl-position dat '(13 32)))) (princ "\n** User Quit **") nil) (t))))))) (princ)) Thanks in advance. Quote Link to comment Share on other sites More sharing options...
fixo Posted June 24, 2010 Share Posted June 24, 2010 Here is simple routine for you No error trapping though (vl-load-com) (defun c:ALE (/ atent attobj ent leng obj) (while (setq ent (entsel "\nSelect Polyline (or press eEnter to Exit): ")) (setq obj (vlax-ename->vla-object (car ent))) (setq leng (rtos (vlax-get-property obj "Length") 2 3 ; <--precison 3 decimals ) ) (if (setq atent (nentsel "\nSelect Attribute: ")) (progn (setq attobj (vlax-ename->vla-object (car atent))) (vlax-put-property attobj "TextString" leng) ) ) ) (princ) ) (prompt "\nStart command with ALE") (prin1) ~'J'~ Quote Link to comment Share on other sites More sharing options...
sakinen Posted June 24, 2010 Author Share Posted June 24, 2010 Thanks a lot. This is realy simplistic aproach. Always the best one... Im trying to put scale factor for a lenght value and multiply it by 2. Its supposed to measure double pipe runs. Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 24, 2010 Share Posted June 24, 2010 You could also use a field... (defun c:L2T (/ curve obj) ;; Alan J. Thompson, 06.24.10 (if (and (setq curve (car (AT:GetSel entsel "\nSelect LWPolyline: " (lambda (x) (eq "LWPOLYLINE" (cdr (assoc 0 (entget (car x)))))) ) ) ) (setq obj (car (AT:GetSel nentsel "\nSelect text object to place value: " (lambda (x) (vlax-property-available-p (vlax-ename->vla-object (car x)) 'TextString ) ) ) ) ) ) (vl-catch-all-apply (function vla-put-textstring) (list (vlax-ename->vla-object obj) (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectID (vlax-ename->vla-object curve))) ">%).Length \\f \"%lu2%pr2\">%" ) ) ) ) (princ) ) (defun AT:GetSel (meth msg fnc / ent good) ;; meth - selection method (entsel, nentsel, nentselp) ;; msg - message to display (nil for default) ;; fnc - optional function to apply to selected object ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC"))) ;; Alan J. Thompson, 05.25.10 (setvar 'errno 0) (while (not good) (setq ent (meth (cond (msg) ("\nSelect object: ") ) ) ) (cond ((vl-consp ent) (setq good (if (or (not fnc) (fnc ent)) ent (prompt "\nInvalid object!") ) ) ) ((eq (type ent) 'STR) (setq good ent)) ((setq good (eq 52 (getvar 'errno))) nil) ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again."))) ) ) ) Quote Link to comment Share on other sites More sharing options...
fixo Posted June 24, 2010 Share Posted June 24, 2010 Thanks a lot. This is realy simplistic aproach. Always the best one... Im trying to put scale factor for a lenght value and multiply it by 2. Its supposed to measure double pipe runs. Just multyplied on 2: (vl-load-com) (defun c:ALE (/ atent attobj ent leng obj) (while (setq ent (entsel "\nSelect Polyline (or press eEnter to Exit): ")) (setq obj (vlax-ename->vla-object (car ent))) (setq leng (rtos (* 2 (vlax-get-property obj "Length")); <--multiply on 2 2 3 ; <--precison 3 decimals ) ) (if (setq atent (nentsel "\nSelect Attribute: ")) (progn (setq attobj (vlax-ename->vla-object (car atent))) (vlax-put-property attobj "TextString" leng) ) ) ) (princ) ) (prompt "\nStart command with ALE") (prin1) ~'J'~ Quote Link to comment Share on other sites More sharing options...
sakinen Posted June 24, 2010 Author Share Posted June 24, 2010 Just multyplied on 2: did the same thing. Thanks a lot anyway! Quote Link to comment Share on other sites More sharing options...
fixo Posted June 24, 2010 Share Posted June 24, 2010 did the same thing. Thanks a lot anyway! Please, attach your drawing here to see where is a problem (I use A2009) ~'J'~ Quote Link to comment Share on other sites More sharing options...
DB007 Posted August 28, 2010 Share Posted August 28, 2010 Here is simple routine for youNo error trapping though (vl-load-com) (defun c:ALE (/ atent attobj ent leng obj) (while (setq ent (entsel "\nSelect Polyline (or press eEnter to Exit): ")) (setq obj (vlax-ename->vla-object (car ent))) (setq leng (rtos (vlax-get-property obj "Length") 2 3 ; <--precison 3 decimals ) ) (if (setq atent (nentsel "\nSelect Attribute: ")) (progn (setq attobj (vlax-ename->vla-object (car atent))) (vlax-put-property attobj "TextString" leng) ) ) ) (princ) ) (prompt "\nStart command with ALE") (prin1) ~'J'~ If i understand this right its exactly the same thing as I want to do, but as its my first time using LISP can someone break this down for me so I can customise it to my needs. Tried to copy exactly, but I get an error straight away and have no idea where to start dissecting to fix. Thanks in advance. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 28, 2010 Share Posted August 28, 2010 Not sure if this helps, but I had fun writing it anyway: (defun c:Len2Fld ( / *error* tables doc spc p s q ExitFlag ) (vl-load-com) ;; © Lee Mac 2010 (defun *error* ( msg ) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (setq tables (LM:ss->vla (ssget "_X" '((0 . "ACAD_TABLE"))))) (LM:ActiveSpace 'doc 'spc) (cond ( (setq p (LM:Selectif (lambda ( x ) (vlax-property-available-p (vlax-ename->vla-object x) 'Length ) ) "\nSelect Object: " nil ) ) (setq s (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:GetObjectID doc (vlax-ename->vla-object p)) ">%).Length \\f \"%lu6\">%" ) ) (while (progn (or ExitFlag (progn (initget "Point") (setq p (nentsel "\nSelect Text, MText or Attribute for Result [Point] <Exit> : ")) ) ) (cond ( ExitFlag nil ) ( (vl-consp p) (if (wcmatch (cdr (assoc 0 (entget (car p)))) "ATTRIB,*TEXT") (vla-put-TextString (vlax-ename->vla-object (car p)) s) (princ "\n** Object Must be Text, MText or Attribute **") ) ) ( (eq "Point" p) (while (progn (initget "Object") (setq q (getpoint "\nSpecify Point for Field [Object] <Exit> : ")) (cond ( (vl-consp q) (cond ( (LM:TextinCell tables q s) ) ( (setq o (vla-AddMText spc (vlax-3D-point (trans q 1 0)) 0 s)) (vla-put-AttachmentPoint o acAttachmentPointMiddleCenter) (vla-put-InsertionPoint o (vlax-3D-point (trans q 1 0))) ) ) (setq ExitFlag t) nil ) ( (eq "Object" q) nil ) ( (setq ExitFlag t) nil ) ) ) ) t ) ) ) ) ) ) (vla-regen doc AcActiveViewport) (princ) ) ;;--------------------=={ ActiveSpace }==---------------------;; ;; ;; ;; Retrieves pointers to the Active Document and Space ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; *doc - quoted symbol other than *doc ;; ;; *spc - quoted symbol other than *spc ;; ;;------------------------------------------------------------;; (defun LM:ActiveSpace ( *doc *spc ) ;; © Lee Mac 2010 (set *spc (if (or (eq AcModelSpace (vla-get-ActiveSpace (set *doc (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) ) (eq :vlax-true (vla-get-MSpace (eval *doc))) ) (vla-get-ModelSpace (eval *doc)) (vla-get-PaperSpace (eval *doc)) ) ) ) ;;---------------------=={ Select if }==----------------------;; ;; ;; ;; Continuous selection prompts until the predicate function ;; ;; foo is validated ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; foo - predicate function taking ename argument ;; ;; str - prompt string ;; ;; nest - boolean flag determining use of nested selection ;; ;;------------------------------------------------------------;; ;; Returns: selected entity ename if successful, else nil ;; ;;------------------------------------------------------------;; (defun LM:Selectif ( foo str nest / e ) ;; © Lee Mac 2010 (while (progn (setq e (car ((if nest nentsel entsel) str))) (cond ( (eq 'ENAME (type e)) (if (not (foo e)) (princ "\n** Invalid Object Selected **")) ) ) ) ) e ) ;;-------------------=={ Get Object ID }==--------------------;; ;; ;; ;; Returns a string containing the ObjectID for the ;; ;; specified VLA-Object ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; doc - VLA Document Object ;; ;; obj - VLA Object for which to return the Object ID ;; ;;------------------------------------------------------------;; ;; Returns: String containing the ObjectID for 'obj' ;; ;;------------------------------------------------------------;; (defun LM:GetObjectID ( doc obj ) ;; © Lee Mac 2010 (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE"))) (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false) (itoa (vla-get-Objectid obj)) ) ) ;;-------------------=={ Text in Cell }==---------------------;; ;; ;; ;; If specified point lies inside a table cell, cell text is ;; ;; set to the specified string. ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; tables - a list of VLA Table Objects to be checked ;; ;; pt - a 3D Point ;; ;; str - a string to populate the cell ;; ;;------------------------------------------------------------;; ;; Returns: T if text is allocated into a cell, else nil ;; ;;------------------------------------------------------------;; (defun LM:TextinCell ( tables pt str / data ) ;; © Lee Mac 2010 (if (setq data (vl-some (function (lambda ( table ) (if (eq :vlax-true (vla-hittest table (vlax-3D-point (trans pt 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col ) ) (list table row col) ) ) ) tables ) ) (not (apply (function vla-setText) (append data (list str)) ) ) ) ) ;;-----------------=={ SelectionSet -> VLA }==----------------;; ;; ;; ;; Converts a SelectionSet to a list of VLA Objects ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; ss - Valid SelectionSet (Pickset) ;; ;;------------------------------------------------------------;; ;; Returns: List of VLA Objects ;; ;;------------------------------------------------------------;; (defun LM:ss->vla ( ss ) ;; © Lee Mac 2010 (if ss ( (lambda ( i / e l ) (while (setq e (ssname ss (setq i (1+ i)))) (setq l (cons (vlax-ename->vla-object e) l)) ) l ) -1 ) ) ) Will place result as a FIELD in either Text, MText, Attribute or Table, or as a new MText Object. Quote Link to comment Share on other sites More sharing options...
DB007 Posted August 28, 2010 Share Posted August 28, 2010 Thanks Lee, A little bit over my head at the moment though. Although, I have made some progress with fixos code. I have it working just need to make a small tweek. Is it possible to use a selection window to select multiple polylines and add the length of them all together instead of just the one line? Is there a reference any where of all lisp commands? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted August 28, 2010 Share Posted August 28, 2010 Here is how I might code that: (defun c:addlen ( / ss ) (vl-load-com) ;; © Lee Mac 2010 (if (setq ss (ssget '((0 . "LINE,*POLYLINE")))) ( (lambda ( i total / e ) (while (setq e (ssname ss (setq i (1+ i)))) (setq total (+ total (vla-get-length (vlax-ename->vla-object e)))) ) (princ (strcat "\n<< Length: " (rtos total) " >>")) ) -1 0 ) ) (princ) ) My code steps through the selection set of lines and polylines and adds the length of each VLA Object cumulatively, printing the result at the end. For a reference, I suggest you open a new ACAD Drawing and type VLIDE at the command line, then go to File > New File. Here you can start typing code, and for help on a function, double-click it to highlight it then click on the beige speech bubble button (help) for help on that function. Note that help for the VLA-* functions is written for VBA, but can be easily translated to VLISP as all the arguements, their type and order apply. For completeness, to update my original code to allow for multiple selection: (defun c:Len2Fld ( / *error* tables doc spc ss p s q ExitFlag ) (vl-load-com) ;; © Lee Mac 2010 (defun *error* ( msg ) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (setq tables (LM:ss->vla (ssget "_X" '((0 . "ACAD_TABLE"))))) (LM:ActiveSpace 'doc 'spc) (cond ( (setq ss (LM:ss->vla (ssget '((0 . "LINE,*POLYLINE"))))) (setq s (if (= 1 (length ss)) (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:GetObjectID doc (car ss)) ">%).Length \\f \"%lu6\">%") (strcat "%<\\AcExpr %<\\AcObjProp Object(%<\\_ObjId " (LM:lst->str (mapcar (function (lambda ( x ) (LM:GetObjectID doc x)) ) ss ) ">%).Length>% + %<\\AcObjProp Object(%<\\_ObjId " ) ">%).Length>% \\f \"%lu6\">%" ) ) ) (while (progn (or ExitFlag (progn (initget "Point") (setq p (nentsel "\nSelect Text, MText or Attribute for Result [Point] <Exit> : ")) ) ) (cond ( ExitFlag nil ) ( (vl-consp p) (if (wcmatch (cdr (assoc 0 (entget (car p)))) "ATTRIB,*TEXT") (vla-put-TextString (vlax-ename->vla-object (car p)) s) (princ "\n** Object Must be Text, MText or Attribute **") ) ) ( (eq "Point" p) (while (progn (initget "Object") (setq q (getpoint "\nSpecify Point for Field [Object] <Exit> : ")) (cond ( (vl-consp q) (cond ( (LM:TextinCell tables q s) ) ( (setq o (vla-AddMText spc (vlax-3D-point (trans q 1 0)) 0 s)) (vla-put-AttachmentPoint o acAttachmentPointMiddleCenter) (vla-put-InsertionPoint o (vlax-3D-point (trans q 1 0))) ) ) (setq ExitFlag t) nil ) ( (eq "Object" q) nil ) ( (setq ExitFlag t) nil ) ) ) ) t ) ) ) ) ) ) (vla-regen doc AcActiveViewport) (princ) ) ;;--------------------=={ ActiveSpace }==---------------------;; ;; ;; ;; Retrieves pointers to the Active Document and Space ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; *doc - quoted symbol other than *doc ;; ;; *spc - quoted symbol other than *spc ;; ;;------------------------------------------------------------;; (defun LM:ActiveSpace ( *doc *spc ) ;; © Lee Mac 2010 (set *spc (if (or (eq AcModelSpace (vla-get-ActiveSpace (set *doc (vla-get-ActiveDocument (vlax-get-acad-object) ) ) ) ) (eq :vlax-true (vla-get-MSpace (eval *doc))) ) (vla-get-ModelSpace (eval *doc)) (vla-get-PaperSpace (eval *doc)) ) ) ) ;;-------------------=={ Get Object ID }==--------------------;; ;; ;; ;; Returns a string containing the ObjectID for the ;; ;; specified VLA-Object ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; doc - VLA Document Object ;; ;; obj - VLA Object for which to return the Object ID ;; ;;------------------------------------------------------------;; ;; Returns: String containing the ObjectID for 'obj' ;; ;;------------------------------------------------------------;; (defun LM:GetObjectID ( doc obj ) ;; © Lee Mac 2010 (if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE"))) (vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false) (itoa (vla-get-Objectid obj)) ) ) ;;-------------------=={ Text in Cell }==---------------------;; ;; ;; ;; If specified point lies inside a table cell, cell text is ;; ;; set to the specified string. ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; tables - a list of VLA Table Objects to be checked ;; ;; pt - a 3D Point ;; ;; str - a string to populate the cell ;; ;;------------------------------------------------------------;; ;; Returns: T if text is allocated into a cell, else nil ;; ;;------------------------------------------------------------;; (defun LM:TextinCell ( tables pt str / data ) ;; © Lee Mac 2010 (if (setq data (vl-some (function (lambda ( table ) (if (eq :vlax-true (vla-hittest table (vlax-3D-point (trans pt 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col ) ) (list table row col) ) ) ) tables ) ) (not (apply (function vla-setText) (append data (list str)) ) ) ) ) ;;-----------------=={ SelectionSet -> VLA }==----------------;; ;; ;; ;; Converts a SelectionSet to a list of VLA Objects ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; ss - Valid SelectionSet (Pickset) ;; ;;------------------------------------------------------------;; ;; Returns: List of VLA Objects ;; ;;------------------------------------------------------------;; (defun LM:ss->vla ( ss ) ;; © Lee Mac 2010 (if ss ( (lambda ( i / e l ) (while (setq e (ssname ss (setq i (1+ i)))) (setq l (cons (vlax-ename->vla-object e) l)) ) l ) -1 ) ) ) ;;-------------------=={ List to String }==-------------------;; ;; ;; ;; Constructs a string from a list of strings separating ;; ;; each element by a specified delimiter ;; ;;------------------------------------------------------------;; ;; Author: Lee McDonnell, 2010 ;; ;; ;; ;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;; ;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; lst - a list of strings to process ;; ;; del - delimiter by which to separate each list element ;; ;;------------------------------------------------------------;; ;; Returns: String containing each string in the list ;; ;;------------------------------------------------------------;; (defun LM:lst->str ( lst del ) ;; © Lee Mac 2010 (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) Lee Quote Link to comment Share on other sites More sharing options...
alanjt Posted August 28, 2010 Share Posted August 28, 2010 (defun c:Len (/ ss) ;; Alan J. Thompson, 08.28.10 (if (setq ss (ssget '((0 . "ARC,*LINE")))) ((lambda (i v / e) (while (setq e (ssname ss (setq i (1+ i)))) (setq v (+ v (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))) ) (alert (princ (strcat "\nTotal length: " (rtos v)))) ) -1 0. ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Jayaramcv Posted June 3, 2013 Share Posted June 3, 2013 Here is simple routine for youNo error trapping though (vl-load-com) (defun c:ALE (/ atent attobj ent leng obj) (while (setq ent (entsel "\nSelect Polyline (or press eEnter to Exit): ")) (setq obj (vlax-ename->vla-object (car ent))) (setq leng (rtos (vlax-get-property obj "Length") 2 3 ; <--precison 3 decimals ) ) (if (setq atent (nentsel "\nSelect Attribute: ")) (progn (setq attobj (vlax-ename->vla-object (car atent))) (vlax-put-property attobj "TextString" leng) ) ) ) (princ) ) (prompt "\nStart command with ALE") (prin1) ~'J'~ Hi, I need the same lisp to update the length of the PL in the designated field of the block. Thanking you in advance, Jayaram.C.V. Quote Link to comment Share on other sites More sharing options...
sergiu_ciuhnenco Posted April 9, 2016 Share Posted April 9, 2016 Could somebody tell me how also divide by 2 ( /2) the length and then attach it to attribute in this code (vl-load-com) (defun c:ALE (/ atent attobj ent leng obj) (while (setq ent (entsel "\nSelect Polyline (or press eEnter to Exit): ")) (setq obj (vlax-ename->vla-object (car ent))) (setq leng (rtos (vlax-get-property obj "Length") 2 3 ; <--precison 3 decimals ) ) (if (setq atent (nentsel "\nSelect Attribute: ")) (progn (setq attobj (vlax-ename->vla-object (car atent))) (vlax-put-property attobj "TextString" leng) ) ) ) (princ) ) (prompt "\nStart command with ALE") (prin1) Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted April 9, 2016 Share Posted April 9, 2016 (defun c:ALE (/ atent attobj ent leng obj) (vl-load-com) (while (setq ent (entsel "\nSelect Polyline (or press eEnter to Exit): ")) (setq obj (vlax-ename->vla-object (car ent))) (setq leng (rtos [color=red](/ (vlax-get-property obj "Length") 2.0) ; <--length divided by 2.0[/color] 2 3 ; <--precison 3 decimals ) ) (if (setq atent (nentsel "\nSelect Attribute: ")) (progn (setq attobj (vlax-ename->vla-object (car atent))) (vlax-put-property attobj "TextString" leng) ) ) ) (princ) ) (prompt "\nStart command with ALE") (prin1) Quote Link to comment Share on other sites More sharing options...
sergiu_ciuhnenco Posted April 9, 2016 Share Posted April 9, 2016 Thanks MARKO !!!!!!! Quote Link to comment Share on other sites More sharing options...
NASR FARHAT Posted May 30, 2016 Share Posted May 30, 2016 Hi all, I need your help in writing a lisp that inserts a pre-defined block (e.g. "Xtag" attached herein) in the middle of a polyline and to write the length of this polyline in one of its attributes (e.g. "Length"). The lisp should allow for multiple selection. I am attaching the block Xtag and a reference drawing to be used as a template. Thank you in advance! Nasr XTag.dwg FG-CHW.dwg 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.