help with Lisp that moves block attribute text

[Maynard_Rowley]

I need a lisp routine that will move all of the attribute text in a block by a specific distance.  I downloaded a Lisp that asked the user to select a block, asked the user for a displacement and then moved the attribute text within the selected block by the amount given. The lisp also created a duplicate of the attribute text so that the user would get a nice preview of where the text was going to be moved when they were entering the displacement.

I only need to modify one specific block every time so I've tweaked the lisp to select this block automatically.  I also need to move the attribute text a the same distance each time so I've modified the lisp so it no longer asks for the displacement.  My questions now are:

1)  What lines of code can I remove to prevent the lisp from creating the preview text?

2)  Is there a way for me to split up the attributes so that all attributes of a particular size are moved one distance and all other attributes are moved a different distance?  (ex:  all attribute text that is 2.4 in size moved 1.875" and text that is 0.09375 is moved 0.6")

Any help greatly appreciated.

[Maynard_Rowley]

Had a brain-fart on the first question; I have that figured out now (code below).  I'm still not sure how te separate the attribute  text so I can move them different amounts based on text height.  Any ideas?

(defun c:amove (/ atSet    actDoc atLst actSp curTxt aFlg laySt mDel bPtdPt *error*)
  (vl-load-com)
  (setq OSM (getvar "osmode")); save Object Snaps
  (setvar "osmode" 0); turn off Object Snaps
  (if
    (setq atLst(ssget "_X" '((0 . "INSERT")(66 . 1)(2 . "Title Blocks D Size Title Block,`*U*"))))      
    (progn
      (setq
    atLst (apply 'append(mapcar 'asmi-GetAttributes (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex atLst))))); end mapcar); end apply
    tSet   (ssadd)
    actSp  (asmi-GetActiveSpace)
    laySt  (asmi-LayersUnlock)
    actDoc (vla-get-ActiveDocument(vlax-get-acad-object))
      ); end setq
      (vla-StartUndoMark actDoc)
      (foreach att atLst
    (vla-Move att (vlax-3d-Point (0.0 0.0 0.0)) (vlax-3d-Point (0.0 2.0 0.0)))
      ); end foreach
      (setvar "CMDECHO" 0)
      (command "_.erase" tSet "")
      (setvar "CMDECHO" 1)
      (asmi-LayersStateRestore laySt)
      (vla-EndUndoMark actDoc)
    ); end progn
  ); end if
  (setvar "osmode" OSM); restore users Object Snaps      
  (princ)
); end of c:amove

(princ "\nType AMOVE to move several attributes. ")

(defun *error* (msg)
  (if  tSet
    (progn
      (setvar "CMDECHO" 0)
      (command "_.erase" tSet "")
      (setvar "CMDECHO" 1)
    ); end progn
  ); end if
  (if    laySt(asmi-LayersStateRestore laySt)
  ); end if
  (if    actDoc(vla-EndUndoMark actDoc)
  ); end if
  (princ)
); end defun of *error*


(defun asmi-LayersUnlock (/ restLst)
  (setq restLst '())
  (vlax-for lay (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq restLst
    (append restLst
      (list
        (list lay (vla-get-Lock lay)
    ); end list
      ); end list
    ); end append
  ); end setq
  (vla-put-Lock lay :vlax-false)); end vlax-for
  restLst
); end defun of asmi-LayersUnlock


(defun asmi-LayersStateRestore (StateList)
  (foreach lay StateList
    (vla-put-Lock (car lay) (cadr lay))
  ); end foreach
  (princ)
); end of asmi-LayersStateRestore


(defun asmi-GetAttributes (Block / atArr caArr)
  (append
    (if
      (not
    (vl-catch-all-error-p
      (setq atArr
        (vl-catch-all-apply 'vlax-safearray->list
          (list (vlax-variant-value(vla-GetAttributes Block))); end list
        ); end vl-catch-all-apply
      ); end setq
        ); end vl-catch-all-error-p
      ); end not
      atArr
    ); end if
    (if
      (not
        (vl-catch-all-error-p
      (setq caArr
            (vl-catch-all-apply 'vlax-safearray->list
          (list (vlax-variant-value (vla-GetConstantAttributes Block))); end list
        ); end vl-catch-all-apply
      );end setq
    ); end vl-catch-all-apply
      ); end not
      caArr
    ); end if
  ); end if
); end defun asmi-GetAttributes


(defun asmi-GetActiveSpace (/ actDoc)
  (setq actDoc(vla-get-ActiveDocument(vlax-get-acad-object)))
  (if
    (= 1 (getvar "TILEMODE"))
    (vla-get-ModelSpace actDoc)
    (vla-get-PaperSpace actDoc)
  ); end if
); end of asmi-GetActiveSpace

[Hallex]

You can define before all of your attributes text height:

Just a quick hint, untested:

     (vla-StartUndoMark actDoc)
      (setq txtHeight1 1.0
	    txtHeight2 1.25
	    txtHeight3 1.5);ETC
      (foreach att atLst
	
	(cond ((equal (vla-get-height att) txtHeight1 0.001)
    (vla-Move att (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(0.0 2.0 0.0))))
	      ((equal (vla-get-height att) txtHeight2 0.001)
    (vla-Move att (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(0.0 3.0 0.0))))
	      ((equal (vla-get-height att) txtHeight3 0.001)
    (vla-Move att (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(0.0 4.0 0.0))));ETC
	      (T nil))
      )
      ; end foreach

 Change the possible values to your needs,

I mean moving points and heights,

Cheers

[Maynard_Rowley]

That works great!  Thank you!

One last question (I hope):  Is there a way to underline multiline atribute text using LISP?  I'd like to make this routine do that as well.

[Hallex]

You can use mtext format options for that, see Help file for more

Shortly, you can use this way, firstly check if attribute is multiline,

then add underline format option, e.g:  \L

      (if (eq :vlax-true
	      (vla-get-mtextattribute att))
(vla-put-textstring att
  (strcat "\\L"(vla-get-mtextattributecontent att))))

 Cheers,

[jamieq]

I've been using this lisp program for a few months now, and appreciate it like crazy. However, the error handler seems to be broken. When I select blocks with attributes and press enter, then press escape, the ghost attribute text objects are still there.