Insert Block, prompt use for properties, place, explode and remove constraints?

[newby]

I am using dynamic blocks to automate the creation of 2.5d axis milling tool paths for a number of interrelated parts.

 

I have a dynamic block with 6 visibility states, 7 parameters that need entered by the user, 223 ancillary parameters and a ton of geometric constraints to keep it all together.

 

The problem is that even on my workstation (i5 750 OC'd with 16gb ram, ATi 2d card) inserting and working with this block is slow. Naturally, the latency issue worsens as I add subsequent instances of the block to a drawing.

 

Is there a LISP routine that can prompt the user for which block to insert, then prompt for the 7 necessary parameters and the desired visibility state, insert the block at the specified point, then explode and remove all geometric constraints?

 

THANKS!

Edited October 16, 2011 by newby
brain fuzz

[newby]

I found this after some trolling.

 

;;;  Tlindell 2007
;;;
;;;  This routine is designed to prompt parameters and attributes when a block is inserted in a drawing.
;;;  The routine will engage after the insert command, a block is dragged from a toolpalette or the Design Center.
;;;  The routine turns off normal attribute prompting and issues it's own.  This was to fix certain prompting issues.
;;;  The routine filters out any parameters that do not show up on the Properties palette.
;;;
;;;*******************************************************************
;;;support functions
(vl-load-com)
(vl-load-reactors)
;;;*******************************************************************
;;;callback functions
(defun gp:binsertatts (a b / ss obj objattr nwstr)
 (if (or (eq (car b) "EXECUTETOOL") (eq (car b) "DROPGEOM") (eq (car b) "INSERT") (eq (car b) "-INSERT"))
   (setvar "attreq" 0)
 )
)
(defun gp:binsertatte (a b / ss->objlist ss obj objattr nwstr objdyn newvalue prmpts cnt dyn dynp)
 (defun ss->objlist (ss / cnt objlist)
   (setq cnt (sslength ss))
   (repeat cnt
     (setq objlist (append objlist (list (vlax-ename->vla-object (ssname ss (- cnt 1))))))
     (setq cnt (- cnt 1))
   )
   (setq ss nil)
   objlist
 )
 (if (or (eq (car b) "EXECUTETOOL") (eq (car b) "DROPGEOM") (eq (car b) "INSERT") (eq (car b) "-INSERT"))
   (progn
     (setq dyn (getvar "dynmode"))
     (setq dynp (getvar "dynprompt"))
     (setvar "dynprompt" 1)
     (setvar "dynmode" 1)
     (setq ss (ssget "L"))
     (setq obj (ss->objlist ss))
     (foreach o obj
       (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename o)))) "INSERT")
         (progn
           (if (= (vla-get-HasAttributes o) :vlax-true)
             (progn
               (setq objattr (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
               (foreach oa objattr
                 (setq oatr oa)
                 (if (= (vla-get-Constant oa) :vlax-false)
                   (progn
                     (setq nwstr (getstring (strcat "\nSpecify " (vla-get-TagString oa) ": <" (vla-get-TextString oa) ">: ")))
                     (if (/= nwstr "") (vla-put-TextString oa nwstr))
                     (setq nwstr nil)
                   )
                 )
               )
             )
           )
           (if (= (vla-get-IsDynamicBlock o) :vlax-true)
             (progn
               (setq objdyn (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties o))))
               (foreach od objdyn
                 (if (and (= (vla-get-Show od) :vlax-true) (= (vla-get-ReadOnly od) :vlax-false) (/= (vla-get-PropertyName od) "Origin"))
                   (progn
                     (if (= (vlax-safearray-get-u-bound (vlax-variant-value (vla-get-AllowedValues od)) 1) -1)
                       (progn
                         (if (= (vla-get-Description od) "")
                           (setq prmpts (strcat "\nEnter value for " (vla-get-PropertyName od) ":"))
                           (setq prmpts (strcat "\nEnter value for " (vla-get-Description od) ":"))
                         )
                         (cond
                           ((= (vla-get-UnitsType od) acAngular) (setq newvalue (getorient prmpts)))
                           ((= (vla-get-UnitsType od) acDistance) (setq newvalue (getdist prmpts)))
                           ((= (vla-get-UnitsType od) acArea) (setq newvalue (getreal prmpts)))
                         )
                         (if (/= newvalue nil) (vla-put-Value od (vlax-make-variant newvalue)))
                       )
                       (progn
                         (setq prmpts "[")
                         (setq cnt 1)
                         (foreach pt (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))
                           (if (= (vla-get-UnitsType od) acNoUnits)
                             (if (numberp (vlax-variant-value pt))
                               (if (= (vlax-variant-value pt) 0)
                                 (setq prmpts (strcat prmpts (itoa cnt) ").NotFlipped "))
                                 (setq prmpts (strcat prmpts (itoa cnt) ").Flipped "))
                               )
                               (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (vlax-variant-value pt))) " "))
                             )
                             (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (rtos (vlax-variant-value pt)))) " "))
                           )
                           (setq cnt (+ cnt 1))
                         )
                         (setq prmpts (strcat (vl-string-right-trim " " prmpts) "]"))
                         (initget 0 (vl-string-trim "[]" prmpts))
                         (if (= (vla-get-Description od) "")
                           (setq newvalue (getkword (strcat "\nEnter value for " (vla-get-PropertyName od) ":" (vl-string-translate " " "/" prmpts))))
                           (setq newvalue (getkword (strcat "\nEnter value for " (vla-get-Description od) ":" (vl-string-translate " " "/" prmpts))))
                         )
                         (if (/= newvalue nil)
                           (progn
                             (setq newvalue (nth (- (atoi (substr newvalue 1 (vl-string-position 41 newvalue))) 1) (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))))
                             (vla-put-Value od newvalue)
                           )
                         )
                       )
                     )
                   )
                 )
               )
             )
           )
         )
       )
     )
     (setvar "dynmode" dyn)
     (setvar "dynprompt" dynp)
   )
 )
 (setvar "attreq" 1)
 (princ)
)
;;;*******************************************************************
;;;reactors
(setq rinsrte (vlr-command-reactor nil '((:vlr-commandEnded . gp:binsertatte))))
(setq rinsrts (vlr-command-reactor nil '((:vlr-commandWillStart . gp:binsertatts))))

 

http://forums.autodesk.com/t5/Dynamic-Blocks/Setting-Parameter-values-at-block-insertion/td-p/3062224

Edited October 16, 2011 by newby
forgot to post source