Author Topic: Add Block  (Read 3690 times)

0 Members and 1 Guest are viewing this topic.

velasquez

  • Newt
  • Posts: 195
Add Block
« on: July 02, 2009, 10:11:38 AM »
Does anybody can me to show as creating a block using VisualLisp?   
(Vla-add block ...?

Thanks

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Add Block
« Reply #1 on: July 02, 2009, 10:28:17 AM »
You can create the block definition by using vla-add, then think of it as another space:

Code: [Select]
(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)))

Spike Wilbury

  • Guest
Re: Add Block
« Reply #2 on: July 02, 2009, 10:34:13 AM »
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
Code: [Select]
;; (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".
« Last Edit: July 02, 2009, 10:44:53 AM by LE »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Add Block
« Reply #3 on: July 02, 2009, 11:15:45 AM »
Sub Functions 8-)

Code: [Select]
(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"))))
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Spike Wilbury

  • Guest
Re: Add Block
« Reply #4 on: July 02, 2009, 11:40:50 AM »
Sub Functions 8-) ...

Gracias Alan. :)

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Add Block
« Reply #5 on: July 02, 2009, 11:55:06 AM »
I think we may still be missing this one:

Code: [Select]
(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-)

Spike Wilbury

  • Guest
Re: Add Block
« Reply #6 on: July 02, 2009, 12:00:42 PM »
I think we may still be missing this one:

 8-)

Yes. - thanks.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Add Block
« Reply #7 on: July 02, 2009, 12:02:34 PM »
Thanks Lee, that one had scrolled off the screen & in my haste I missed it.  :oops:
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Add Block
« Reply #8 on: July 02, 2009, 12:03:21 PM »
Just out of interest, would this be quicker, using a WHILE instead of REPEAT?

Code: [Select]
(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)))


velasquez

  • Newt
  • Posts: 195
Re: Add Block
« Reply #9 on: July 02, 2009, 03:17:02 PM »
Thank you very much to all for the help.