TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: velasquez on July 02, 2009, 10:11:38 AM
-
Does anybody can me to show as creating a block using VisualLisp?
(Vla-add block ...?
Thanks
-
You can create the block definition by using vla-add, then think of it as another space:
(setq myblockspace
(vla-add
(vla-get-Blocks
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(vlax-3d-point '(0 0 0))
"testblock"
))
(vla-addline myblockspace (vlax-3d-point '(0 0 0)) (vlax-3d-point '(0 1 0)))
-
Does anybody can me to show as creating a block using VisualLisp?
(Vla-add block ...?
Thanks
Here is what I used in my lisp days:
edit: the sub-routines not posted here are inside of the url link below
;; (rcmd-makeBlock pt "TEST1" ss T)
(defun rcmd-makeBlock (pt name ss flag / ssArray vla_block)
(vla-copyObjects
(rcmd-thisDwg)
(setq ssArray (rcmd-selectionSet->array ss))
(setq vla_block (vla-add (vla-get-blocks (rcmd-thisDwg))
(vlax-3d-point pt)
name)))
;; delete objects
(if (and flag
ssArray
(= (type ssArray) 'safeArray)
;; is the safeArray made of vlax-object's
(= (vlax-safeArray-type ssArray) 9))
(mapcar 'vla-delete (safeArray-value ssArray)))
vla_block)
(defun rcmd-addBlock (pt name ss flag / vla_block)
(if (not (vl-catch-all-error-p
(setq vla_block
(vl-catch-all-apply
'rcmd-makeBlock
(list pt name ss flag)))))
vla_block))
;; (rcmd-insertBlock inspt "TEST" 1.0 1.0 1.0 0.0)
(defun rcmd-insertBlock
(insertionPoint name
xscale yscale zscale
rotation / vla_insert)
(if (not (vl-catch-all-error-p
(setq vla_insert
(vl-catch-all-apply
'vla-insertBlock
(list (rcmd-get-activeSpace)
(vlax-3d-point insertionPoint)
name
xscale
yscale
zscale
rotation)))))
vla_insert))
(princ)
and inside of this, there are some more stuff, that might be still usefull - maybe
http://www.theswamp.org/index.php?topic=17852.0
as plenty of other stuff here posted by the swamp masters, just do a "search".
-
Sub Functions 8-)
(if (not :rcmAcad)
(setq :rcmAcad (vlax-get-acad-object)))
(defun rcmd-thisDwg () (vla-get-activeDocument :rcmAcad))
(setq dtt_thisdwg
(cond (dtt_thisdwg)
((rcmd-thisDwg))))
(if (not :rcmModel)
(setq :rcmModel (vla-get-modelSpace (rcmd-thisDwg))))
(defun rcmd-pSpace () (vla-get-paperSpace (rcmd-thisDwg)))
(defun rcmd-get-activeSpace ()
(if (= acModelSpace (vla-get-activeSpace (rcmd-thisDwg)))
:rcmModel
(if (= (vla-get-mSpace (rcmd-thisDwg)) :vlax-true)
:rcmModel
(rcmd-pSpace))))
(defun rcmd-activeSpaceName ()
(cond ((= acModelSpace (vla-get-activeSpace (rcmd-thisDwg))) "Model")
(T
(if (= (vla-get-mSpace (rcmd-thisDwg)) :vlax-true)
"Model"
"Paper"))))
-
Sub Functions 8-) ...
Gracias Alan. :)
-
I think we may still be missing this one:
(defun rcmd-selectionSet->array (ss / c r)
(setq c -1)
(repeat (ssLength ss)
(setq r (cons (ssname ss (setq c (1+ c))) r)))
(setq r (reverse r))
(vlax-safeArray-fill
(vlax-make-safeArray
vlax-vbObject
(cons 0 (1- (length r))))
(mapcar 'vlax-ename->vla-object r)))
8-)
-
I think we may still be missing this one:
8-)
Yes. - thanks.
-
Thanks Lee, that one had scrolled off the screen & in my haste I missed it. :oops:
-
Just out of interest, would this be quicker, using a WHILE instead of REPEAT?
(defun lmac-selectionSet->array (ss / e c r)
(setq c -1)
(while (setq e (ssname ss (setq c (1+ c))))
(setq r (cons (vlax-ename->vla-object e) r)))
(vlax-safeArray-fill
(vlax-make-safeArray
vlax-vbObject
(cons 0 (1- (length r))))
(reverse r)))
-
Thank you very much to all for the help.