插入块，提示使用p
我正在使用动态块为许多相互关联的零件自动创建2.5d轴铣削刀具路径。我有一个动态块，有6个可见性状态，7个需要用户输入的参数，223个辅助参数和大量的几何约束来将其保持在一起。
问题是，即使在我的工作站上（i5 750 OC，16gb ram，ATi 2d卡），插入和使用这个块也很慢。当然，当我将块的后续实例添加到图形中时，延迟问题会恶化。
是否有LISP例程可以提示用户插入哪个块，然后提示7个必要参数和所需的可见性状态，在指定点插入块，然后分解并删除所有几何约束？
谢谢！ 我找了几次后发现了这个。
;;;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
页:
[1]