lilyachty Posted November 20, 2024 Posted November 20, 2024 I found this lisp by Peter Jamtgaard that kind of fits my needs however can someone please help me alter the code so it better fits my needs? The current function ATSINC takes only the 1st attribute of the selected blocks and increases/decreases it by a certain amount. I need the code altered so that it prompts the user to specify the name of the attribute and then it would increase/decrease said attribute. Also, it would be nice if it could read letters (simple A-Z) and increase/decrease said letter by the specified increment. Thanks! ;___________________________________________________________________________________________________________| ; ; Written By: Peter Jamtgaard C.E., P.E., S.E. copyright 2018 All Rights Reserved ;___________________________________________________________________________________________________________| ; ; Any use by unauthorized person or business is strictly prohibited. ; Include Shorthand.lsp ;___________________________________________________________________________________________________________| ;___________________________________________________________________________________________________________| ; ; Command Line Function Header List ;___________________________________________________________________________________________________________| ;* C:AtInc ;* Command line function to increment a selected attribute ;* C:AttributeIncrement ;* Command line function to increment a selected attribute ;* C:AtsInc ;* Command line function to increment attributes in selected blocks ;* C:AttributesIncrement ;* Command line function to increment attributes in selected blocks ;___________________________________________________________________________________________________________| ; ; General Function Header List ;___________________________________________________________________________________________________________| ; Function List Argument1 Argument2 Arguement3 ;* (AttributeFromBlock objAttribute) ;* Function to check if attribute or block with attribute and return attribute ;* (AttributeIncrement objAttribute intIncrement) ;* Function to increment an attribute with a value intIncrement ;* (IsAsciiNumeral intAscii) ;* Function to text an Ascii value to see if it a numeral or decimal place ;* (SelectionSetToList ssSelections) ;* Function to convert a entity based selection set to a list ;* (TextIncrement strTextString intIncrement) ;* Function to increment a textstring with a value intIncrement ;* (TextNumeralParse strTextString) ;* Function to parse a string and separate letters and numerals in groups and return a list of strings. ;$ End Header ;___________________________________________________________________________________________________________| ; ; Command line function to increment an attribute ;___________________________________________________________________________________________________________| (defun C:AtInc ()(C:AttributeIncrement)) (defun C:AttributeIncrement (/ entSelection intIncrement lstSelection objAttribute) (while (and (setq intIncrement (getint "\nEnter Increment Value: ")) ;(setq intIncrement 1) (setq lstSelection (nentsel "\nSelect Attribute: ")) (setq entSelection (car lstSelection)) (setq objAttribute (vlax-ename->vla-object entSelection)) (wcmatch (vla-get-objectname objAttribute) "AcDbAttribute") ) (AttributeIncrement objAttribute 1) ) (prin1) ) ;___________________________________________________________________________________________________________| ; ; Command line function to increment attributes in selected blocks ;___________________________________________________________________________________________________________| (defun C:AtsInc ()(C:AttributesIncrement)) (defun C:AttributesIncrement (/ intIncrement lstSelections ssSelections) (if (and (setq intIncrement (getint "\nEnter Increment Value: ")) ;(setq intIncrement 1) (princ "\nSelect Blocks: ") (setq ssSelections (ssget (list (cons 0 "insert")))) (setq lstSelections (SelectionSetToList ssSelections)) ) (mapcar '(lambda (X)(AttributeIncrement X intIncrement)) lstSelections) ) (prin1) ) ;___________________________________________________________________________________________________________| ; ; Function to check if attribute or block with attribute and return attribute ;___________________________________________________________________________________________________________| (defun AttributeFromBlock (objAttribute / lstAttributes) (if (or (wcmatch (vla-get-objectname objAttribute) "AcDbAttribute") (and (wcmatch (vla-get-objectname objAttribute) "AcDbMInsertBlock,AcDbBlockReference") (= (vlax-get objAttribute "HasAttributes") -1) (setq lstAttributes (vlax-invoke objAttribute "getattributes")) (setq objAttribute (car lstAttributes)) ) ) objAttribute ) ) ;___________________________________________________________________________________________________________| ; ; Function to increment an attribute with a value intIncrement ;___________________________________________________________________________________________________________| (defun AttributeIncrement (objAttribute intIncrement / sngTextString strTextString) (if (and (setq objAttribute (AttributeFromBlock objAttribute)) (setq strTextString (vla-get-textstring objAttribute)) (setq lstTextStrings (TextNumeralParse strTextString)) (setq lstTextStrings (mapcar '(lambda (X) (TextIncrement X intIncrement)) lstTextStrings)) (setq lstTextStrings (vl-remove nil lstTextStrings)) (setq lstTextStrings (vl-remove "" lstTextStrings)) (setq strTextString (apply 'strcat lstTextStrings)) ) (progn (vla-put-textstring objAttribute strTextString) T) ) ) ;___________________________________________________________________________________________________________| ; ; Function to text an Ascii value to see if it a numeral or decimal place. ;___________________________________________________________________________________________________________| (defun IsAsciiNumeral (intAscii) (and (member intAscii (vl-string->list ".0123456789"))) ) ;___________________________________________________________________________________________________________ ; ; Function to convert a entity based selection set to a list. ;___________________________________________________________________________________________________________ (defun SelectionSetToList (ssSelections / entSelection intCount lstObjects objSelection ) (repeat (setq intCount (sslength ssSelections)) (setq intCount (1- intCount)) (setq entSelection (ssname ssSelections intCount)) (setq objSelection (vlax-ename->vla-object entSelection)) (setq lstObjects (cons objSelection lstObjects)) ) lstObjects ) ;___________________________________________________________________________________________________________| ; ; Function to increment a textstring with a value intIncrement ;___________________________________________________________________________________________________________| (defun TextIncrement (strTextString intIncrement / sngTextString) (if (and (apply 'and (mapcar 'IsAsciiNumeral (vl-string->list strTextString))) (or (and (vl-string-search "." strTextString) (setq sngTextString (atof strTextString)) ) (setq sngTextString (atoi strTextString)) ) (setq sngTextString (+ sngTextString intIncrement)) ) (setq strtextString (vl-princ-to-string sngTextString)) strTextString ) ) ;___________________________________________________________________________________________________________| ; ; Function to parse a string and separate letters and numerals in groups and return a list of strings. ;___________________________________________________________________________________________________________| (defun TextNumeralParse (strTextString / intAsciiOld intAsciiOld lstOfAsciiValues lstSublist) (if (= (type strTextString) 'LIST) (setq strTextString (car strTextString)) ) (foreach intAscii (vl-string->list strTextString) (or (and (or (= (IsAsciiNumeral intAscii) (IsAsciiNumeral intAsciiOld) ) (not intAsciiOld) ) (setq lstSublist (cons intAscii lstSublist)) ) (and (setq lstOfAsciiValues (cons (reverse lstSublist) lstOfAsciiValues)) (setq lstSublist (list intAscii)) ) ) (setq intAsciiOld intAscii) ) (setq lstOfAsciiValues (cons (reverse lstSublist) lstOfAsciiValues)) (mapcar 'vl-list->string (reverse lstOfAsciiValues)) ) (vl-load-com) atinc.lsp Quote
Emmanuel Delay Posted November 22, 2024 Posted November 22, 2024 Her's what I use for simple values. You must have 1 block with the attribute filled in with a number. Command INCF -Then you click on an attribute that has a numeric value (an integer) - then you keep clicking on the destination blocks. (vl-load-com) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (vlax-invoke blk 'getattributes) ) ) ;; increase, on existing blocks (defun c:incF ( / att val tag blk blkName newblock newVal ent2) (setq tag (cdr (assoc 2 (entget (setq att (car(nentsel "\nSelect ATT: "))))))) (setq val (cdr (assoc 1 (entget att)))) (setq blk (cdr (assoc 330 (entget att)))) (setq blkName (cdr (assoc 2 (entget blk)))) (setq newVal (atoi val)) (while (setq ent2 (entsel "\nDestination block: ")) (setq newblock (vlax-ename->vla-object (car ent2))) (setq newVal (+ newVal 1)) (LM:vl-setattributevalue newblock tag (itoa newVal)) ) ) And here's the same thing, but for letters. Command INCL - click on the first attribute containing only 1 letter [a-z] or [A-Z] - click on destination blocks ;; increase letters [a-z], on existing blocks ;; We expect a 1 letter attribute (defun c:incL ( / att val tag blk blkName newblock newVal ent2) (setq tag (cdr (assoc 2 (entget (setq att (car(nentsel "\nSelect ATT: "))))))) (setq val (cdr (assoc 1 (entget att)))) (if (= 1 (strlen val)) (progn (setq blk (cdr (assoc 330 (entget att)))) (setq blkName (cdr (assoc 2 (entget blk)))) ;; ascii value (setq newVal (ascii val)) ;; ascii: a=97, z=122, A=65, Z=90 (while (and (or (and (> newVal 96) (< newVal 122)) ;; letter is [a-z] (and (> newVal 64) (< newVal 90)) ;; letter is [A-Z] ) (setq ent2 (entsel "\nDestination block: ")) ) (setq newblock (vlax-ename->vla-object (car ent2))) (setq newVal (+ newVal 1)) (LM:vl-setattributevalue newblock tag (chr newVal)) ) )) ) Quote
lilyachty Posted November 22, 2024 Author Posted November 22, 2024 4 hours ago, Emmanuel Delay said: Her's what I use for simple values. You must have 1 block with the attribute filled in with a number. Command INCF -Then you click on an attribute that has a numeric value (an integer) - then you keep clicking on the destination blocks. (vl-load-com) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (vlax-invoke blk 'getattributes) ) ) ;; increase, on existing blocks (defun c:incF ( / att val tag blk blkName newblock newVal ent2) (setq tag (cdr (assoc 2 (entget (setq att (car(nentsel "\nSelect ATT: "))))))) (setq val (cdr (assoc 1 (entget att)))) (setq blk (cdr (assoc 330 (entget att)))) (setq blkName (cdr (assoc 2 (entget blk)))) (setq newVal (atoi val)) (while (setq ent2 (entsel "\nDestination block: ")) (setq newblock (vlax-ename->vla-object (car ent2))) (setq newVal (+ newVal 1)) (LM:vl-setattributevalue newblock tag (itoa newVal)) ) ) And here's the same thing, but for letters. Command INCL - click on the first attribute containing only 1 letter [a-z] or [A-Z] - click on destination blocks ;; increase letters [a-z], on existing blocks ;; We expect a 1 letter attribute (defun c:incL ( / att val tag blk blkName newblock newVal ent2) (setq tag (cdr (assoc 2 (entget (setq att (car(nentsel "\nSelect ATT: "))))))) (setq val (cdr (assoc 1 (entget att)))) (if (= 1 (strlen val)) (progn (setq blk (cdr (assoc 330 (entget att)))) (setq blkName (cdr (assoc 2 (entget blk)))) ;; ascii value (setq newVal (ascii val)) ;; ascii: a=97, z=122, A=65, Z=90 (while (and (or (and (> newVal 96) (< newVal 122)) ;; letter is [a-z] (and (> newVal 64) (< newVal 90)) ;; letter is [A-Z] ) (setq ent2 (entsel "\nDestination block: ")) ) (setq newblock (vlax-ename->vla-object (car ent2))) (setq newVal (+ newVal 1)) (LM:vl-setattributevalue newblock tag (chr newVal)) ) )) ) Thanks, but that is not exactly what I'm looking for... I'm looking for a program that prompts the user to enter the attribute tag name [ATT] and increment value [X]. Then the program will read the existing value [Y] (could be a number or letter) in [ATT] attribute b and increase said value by the given increment i.e. [Y]+[X]. For example, given a set of values from the selected attribute [1, 5, 6, 8, 4] Your code given only reads the value of the selected attribute let's say [1] and increases the others by 1 from there resulting in [2, 3, 4, 5, 6] What I'm looking for is, let's say the user inputs an increment value of 2, then the resulting values would be: [2, 6, 7, 9, 5] Also, I would like to select a bunch of blocks rather than clicking one by one. The code I posted does what I need, but it only takes the 1st attribute value and integer values. If you want, you can help alter the code to incorporate user input to indicate the exact attribute to increment and add a letter option as well. Quote
BIGAL Posted November 22, 2024 Posted November 22, 2024 @Emmanuel Delay you have the answer already ;; ascii: a=97, z=122, A=65, Z=90 0=48 9=57 so just check is it between 48-57 so its a number. 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.