Here is a full annotated Vanilla AutoLISP example for you to study:
;; Define function & declare local variables(defun c:atthgt ( / att atx blk bln ent enx hgt tag ) ;; If the following expression returns a non-nil value (if ;; If all of the following expressions return a non-nil value (and ;; Prompt the user to select an attribute (setq att (car (nentsel "\nSelect attribute: "))) ;; Retrieve the DXF data for the selected object (setq atx (entget att)) ;; Check that the selected object is indeed an attribute (= "ATTRIB" (cdr (assoc 0 atx))) ;; Evaluate the following expressions and return the value ;; returned by the last evaluated expression (progn ;; Restrict the following prompt to positive non-zero values (initget 6) ;; Prompt the user for a new text height (setq hgt (getdist "\nSpecify new attribute height: ")) ) ;; end progn ) ;; end and ;; Then: ;; Evaluate the following expressions within a single 'progn' ;; expression constituting the THEN argument for the 'if' function (progn ;; Retrieve the attribute tag of the selected attribute (setq tag (cdr (assoc 002 atx)) ;; Retrieve the parent entity of the attribute reference (i.e. the block reference) blk (cdr (assoc 330 atx)) ;; Retrieve the block name (non-dynamic blocks only!) bln (cdr (assoc 002 (entget blk))) ;; Retrieve the corresponding block record entity for the block ent (tblobjname "block" bln) ) ;; end setq ;; While the following expression returns a non-nil value (while ;; Step through the entities following the block record entity in the database (setq ent (entnext ent)) ;; If the following expression returns a non-nil value (if ;; If all of the following expressions return a non-nil value (and ;; Retrieve the DXF data for the block component (setq enx (entget ent)) ;; Check that it's an ATTDEF (= "ATTDEF" (cdr (assoc 0 enx))) ;; Check that is has the correct tag (= tag (cdr (assoc 2 enx))) ) ;; end and ;; Modify the following DXF data in the drawing database (entmod ;; Substitute the following group (subst ;; Construct a dotted pair to form DXF group 40 (cons 40 hgt) ;; For the existing DXF group 40 entry (assoc 40 enx) ;; Within the ATTDEF dxf data enx ) ;; end subst ) ;; end entmod ) ;; end if ) ;; end while ;; Use the ATTSYNC command to apply the changes to all references of the block (command "_.attsync" "_n" bln) ) ;; end progn ;; Else the initial conditions were not met ;; No real need to inform the user - they will know the error of their ways... ) ;; end if ;; Suppress the value returned by the last evaluated expression (princ)) ;; end defun
Given that I have donated my time to writing this code and commenting every line with an explanation, please take the time to carefully read the comments and study the code.
Lee Jeepers Lee! Christmas has come early for me, loads of comments added! Thank you very much indeed.
I'd actually got slightly further than in my last post, realised that it's the block that needs the entmod & to use tblobjname to search within it for the relevant attribute., but that was as far as my thinking got really.
It's far more than I was expecting & far more complex that I thought the code would be. I created a lisp to change text/mtext heights & it was a doddle, then I thought to add attribute capability....
Just a bit more as an alternative you can change a attribute by its creation order rather than say nentsel & Tagname. Change 3rd attribute. You should be able to apply this to the block definition.
; Change attribute value by created position; By Alan H(vl-load-com)(setq y 1)(setq ss1 (car (entsel)))(setq bname (vla-get-name(vlax-ename->vla-object SS1))) (setq x (getint "\nEnter line no to pick")) ; change this line in block(SETQ newstrblank ".")(foreach att (vlax-invoke (vlax-ename->vla-object SS1) 'getattributes) (if (= y x) (progn (setq newstr (vla-get-textstring att )) (vla-put-textstring att newstrblank) ) ) (setq y (+ Y 1)))(setq y 1)(setq x (getint "\nEnter line no to move to"))(foreach att (vlax-invoke (vlax-ename->vla-object SS1) 'getattributes) (if (= y x) (vla-put-textstring att newstr) ) (setq y (+ Y 1)))(princ) Further to the earlier reply it occurred to me that if there were duplicate tags within the block (quite common, the numbties) then the wrong attribute may get changed. Therefore I thought that if the lisp were using the entity name, which is to the best of my knowlege unique, then it would not amend the wrong attribute. But I'm having trouble making the entity names match.
I'll change the name of the symbol 'tag' to something more suitable later.
This:
(setq tag (cdr (assoc 002 atx))
To this:
(setq tag (cdr (assoc -1 atx))
And this:
(= tag (cdr (assoc 2 enx)))
To this:
(= tag (cdr (assoc -1 enx)))
As you can see from the log watch, the values don't match (not equal) for:
(= tag (cdr (assoc -1 enx)))
...............LOG Watch...............ENT = ENX = ((-1 . ) (0 . "ATTDEF") ~ ~ ~TAG = ...............
But I'm working on it
PS Thanks again for all the commented code, comments are priceless to me when trying something new. Did you see my reply ? Yes I did & I apologise for not replying sooner Tharwat.
I admit that I got a bit frightened off by all those VL functions, ordinary lisp I'm fairly comfortable with when it comes to tweaking it, but I don't yet know enough about visual lisp to feel confident enough to attempt a tweak.
I've just tried your code & it works very well indeed. Please may I ask what criteria the lisp uses to pin-point which attribute is to have it's text height changed (Lee's uses the tag name).
No problem, and its okay.
It may is at the first glance but it would become easy to you by time if you keep on coding and readying about functions you need to use.
Just ask if you have any question about my codes.
I am also used the tag string / name to pick the needed tag string's height to be changed.
Regards.
Entity names & Object IDs are indeed unique within the active drawing session (but not persistent between drawing sessions - only handles are persistent). However, as noted earlier, the attribute selected by the user is the attribute reference (ATTRIB), whereas, the modifications are being performed on the attribute definition (ATTDEF), which is not the same entity.
You're welcome - I'm glad it helps. Here is one possible method to account for duplicate tags:
;; Define function & declare local variables(defun c:atthgt ( / att atx blk bln cnt ent enx flg han hgt tag ) ;; If the following expression returns a non-nil value (if ;; If all of the following expressions return a non-nil value (and ;; Prompt the user to select an attribute (setq att (car (nentsel "\nSelect attribute: "))) ;; Retrieve the DXF data for the selected object (setq atx (entget att)) ;; Check that the selected object is indeed an attribute (= "ATTRIB" (cdr (assoc 0 atx))) ;; Evaluate the following expressions and return the value ;; returned by the last evaluated expression (progn ;; Restrict the following prompt to positive non-zero values (initget 6) ;; Prompt the user for a new text height (setq hgt (getdist "\nSpecify new attribute height: ")) ) ;; end progn ) ;; end and ;; Then: ;; Evaluate the following expressions within a single 'progn' ;; expression constituting the THEN argument for the 'if' function (progn ;; Retrieve the attribute tag of the selected attribute (setq tag (cdr (assoc 002 atx)) ;; Retrieve the handle of the selected attribute (in case there are duplicate tags) han (cdr (assoc 005 atx)) ;; Retrieve the parent entity of the attribute reference (i.e. the block reference) blk (cdr (assoc 330 atx)) ;; Retrieve the block name (non-dynamic blocks only!) bln (cdr (assoc 002 (entget blk))) ;; Retrieve the corresponding block record entity for the block ent (tblobjname "block" bln) ;; Retrieve the first attribute reference entity att (entnext blk) ;; Retrieve the DXF data for the first attribute reference entity atx (entgetatt) ;; Initialise a counter variable cnt 0 ) ;; end setq ;; While the following expression returns a non-nil value (while ;; If all of the following expressions return a non-nil value (and ;; We haven't found the selected attribute reference (not flg) ;; While the entity is an attribute reference (= "ATTRIB" (cdr (assoc 0 atx))) ) ;; end and ;; If the attribute tag matches that of the selected attribute (if (= tag (cdr (assoc 2 atx))) ;; Then increment the counter variable (setq cnt (1+ cnt) ;; Test whether the attribute reference handle matches that of the selected attribute flg (= han (cdr (assoc 5 atx))) ) ;; end setq ) ;; end if ;; Retrieve the next entity in the database (setq att (entnext att) ;; Retrieve the DXF data for the next entity in the database atx (entgetatt) ) ;; end setq ) ;; end while ;; While the following expression returns a non-nil value (while ;; Step through the entities following the block record entity in the database (setq ent (entnext ent)) ;; If the following expression returns a non-nil value (if ;; If all of the following expressions return a non-nil value (and ;; Retrieve the DXF data for the block component (setq enx (entget ent)) ;; Check that it's an ATTDEF (= "ATTDEF" (cdr (assoc 0 enx))) ;; Check that is has the correct tag (= tag (cdr (assoc 2 enx))) ;; And that it is the correct attribute (if duplicate tags exist) (zerop (setq cnt (1- cnt))) ) ;; end and ;; Modify the following DXF data in the drawing database (entmod ;; Substitute the following group (subst ;; Construct a dotted pair to form DXF group 40 (cons 40 hgt) ;; For the existing DXF group 40 entry (assoc 40 enx) ;; Within the ATTDEF dxf data enx ) ;; end subst ) ;; end entmod ) ;; end if ) ;; end while ;; Use the ATTSYNC command to apply the changes to all references of the block (command "_.attsync" "_n" bln) ) ;; end progn ;; Else the initial conditions were not met ;; No real need to inform the user - they will know the error of their ways... ) ;; end if ;; Suppress the value returned by the last evaluated expression (princ)) ;; end defun Thanks for that Lee, I'll give it a try.
When I started this post I expected someone to point out a simple error in my code. It's kinda snowballed!
I think I've broken my vlide playing with bits of code today - it no longer reports global variables on a 'Check Text in Editor' :-(
页:
1
[2]