Looking to *Insert Dynamic Block and rotate Dynamic Grip*

[sbrennan85]

Ok, so I recently found how I can apply a dynamic rotation to a block, keep the text/attribute positioning relative to the original location, but not actually rotate. It's perfect and I'm excited to implement it in my company.

 

However, I'm also working on a few ribbon tabs that will have a bunch of these blocks (different symbols and/or attributes). Right now I'm simply using macros to insert the block, and bypass any steps necessary for that particular block (scale, rotate, etc). However, with a traditional block I need to use a LISP routine that was created years ago here at our company to rotate the attributes (I think it was created before AutoCAD had the function? I don't know, I've only been using CAD for about 8.5 years).

 

I'm trying to do the following in as much automation as possible:

 

1. Insert Dynamic Block
   
2. Scale based on USERR1 value
   
3. Force rotation to 0 degrees
   
4. Allow for user input of Attribute(s)
   
5. Select the (only) Dynamic Rotation Grip
   
6. Allow for user input of Dynamic Rotation
   
7. Repeat all of the above until cancelled
   

I'm pretty sure this is only doable via LISP, but I know NOTHING about LISP programming, and was hoping someone could help out.

 

 

I've attached one of the many blocks I have with this "auto-aligning" text feature.

 

 

Thanks in advance!

SAMPLE.dwg

[fixo]

Try this code:

(defun C:bpro(/ acsp adoc attvalue blkname blkobj prop_lst prop_names pt scl )
 (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
 (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
   (setq acsp (vla-get-paperspace adoc))
   (setq acsp (vla-get-modelspace adoc))
 )
(vla-startundomark adoc)

(setq blkname "RECEPTACLE-DUPLEX-PLAY");<-- block name

(if (not (tblsearch "block" blkname))(progn
 (alert "No such block in drawing, exit.")
 (exit)(princ))
 )

 (if (= 0 (setq scl (getvar "USERR1")))
   (setq scl (getreal "\nEnter User scale value: "))
   (setvar "USERR1" scl)
   )

(while (setq pt (getpoint "\nPick insertion point (Or press Enter to Exit): "))
(setq blkobj (vlax-invoke acsp 'insertblock pt blkname  scl scl scl 0))
(if (eq :vlax-true
(vla-get-isdynamicblock
  (vla-item
    (vla-get-blocks
      (vla-get-activedocument (vlax-get-acad-object))
    )
    (vla-get-effectivename blkobj)
  )
)
   )
 (progn
   (setq prop_names
   (mapcar 'vla-get-propertyname
    (setq
      prop_lst
       (vlax-safearray->list
  (vlax-variant-value
    (vla-getdynamicblockproperties blkobj)
  )
       )
    )
   )
   )
   (foreach prop prop_lst
     (if (and (eq "Angle1" (vla-get-propertyname prop))
       (member "Angle1" prop_names)
  )
(vla-put-value
  prop
  (vlax-make-variant
    0.0
    (vlax-variant-type (vla-get-value prop))
  )
)
     )
   )
 )
)
(setq attvalue (getstring T  "\nEnter attribute value for CCT : "))
  (foreach att (vlax-invoke blkobj 'getattributes)
    (if (eq "CCT" (vla-get-tagstring att))
     (vla-put-textstring att attvalue)
      )
    )


)

(princ)
)
(prompt "\nType BPRO to run the command")
(prin1)
(or (vl-load-com)
   (princ))

 

~'J'~