AUTO-BLOCK Improvement

[Prageeth]

I found valuable lisp for auto creation block.

I want to improve this lisp to following requirement

 

* block selected  object individually, not in one block

thanks

 

  

 

AUTO-BLOCK.LSP

[mhupp]

need a little more instructions

[Prageeth]

If you have 100 of polylines...then select all object at once

                                                    Should  create 100 of block individually

 

[mhupp]

This will make a block of anything selected but only one entity per block. the old macro was picking point 0,0 as the block point. this will give each selection a unique point. currently set to the lower left of the boundary box of the entity. you can change it to UR or MPT depending on what you want. had to put a delay in because the (Set_BlkName) runs off the time and it would generated the same name and caused errors. you could possibly make it lower so this runs faster.

(defun C:AB1 (/ ss i blk obj LL UR)
  (setq ss (ssget))
  (setq i 0)
  (setvar 'cmdecho 0)
  (command "_undo" "be")
    (repeat (sslength ss)
    (command "_.delay" 100)
    (Set_BlkName)
    (setq obj (vlax-ename->vla-object (setq blk (ssname ss i))))
    (vla-getboundingbox obj 'minpt 'maxpt)
    (setq
      LL (vlax-safearray->list minpt) ;lower left point
      UR (vlax-safearray->list maxpt) ;upper right point
    )
    ;(setq MPT (polar LL (angle LL UR) (/ (distance LL UR) 2))) ;midpoint of bounding box
    
    (command "-block" blkname "none" LL blk "")
    (command "-insert" blkname "none" LL 1 1 0)
    ;(prompt (strcat "\n   Block [" blkname "] Created. ")) ;alot of spam if enambled
    (setq i (1+ i))
  )
  (command "_undo" "e")
  (setvar 'cmdecho 1)
  (setq i (rtos i 2 0))
  (prompt (strcat "\n " i " Blocks Created. ")) 
  (princ)
);end C:AB1

--edit--

added undo marks

misspelling

Edited September 25, 2020 by mhupp

[Prageeth]

Thank you. but

got  ; error: no function definition: SET_BLKNAME

[mhupp]

2 hours ago, Prageeth said:

got  ; error: no function definition: SET_BLKNAME

 

You asked to improve the lisp. What i posted is to replace the original AB1 function lines 41 - 52 in AUTO-BLOCK.LSP.

[Prageeth]

Thanx for code..but i have 100 object,

i run the lisp but created only one object to block.

 

Edited September 25, 2020 by Prageeth

[mhupp]

This is what AUTO-BLOCK.LSP should look like after you replace the original AB1 Function with the one i came up with.

;;;========================================================================
;;;                                                                        
;;;                    *** AUTO-BLOCK.LSP ***                              
;;;     BLOCK CREATION ON THE FLY : "Just select your objects"             
;;;                                                                        
;;;               By Raymond RIZKALLAH, October/2004                       
;;;========================================================================

(defun Set_BlkName ()
  (setq o-dmzn (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq c-date (getvar "cdate"))
  (setq w-all (rtos c-date 2 20))         ;; >> "20041022.11423489"
  (setq w-yr (substr w-all 3 2))          ;; ["01" to "99"] >> "04"
  (setq w-mn (substr w-all 5 2)           ;; ["A" to "L"] >> "J"
        w-mn (chr (+ 64 (read w-mn)))     ;;
  )
  (setq w-dy (substr w-all 7 2))          ;; ["A" to "Z" + "1" to "5"] >> "V"
  (if (<= (read w-dy) 26)                 ;;
    (setq w-dy (chr (+ 64 (read w-dy))))  ;;
    (setq w-dy (rtos (- (read w-dy) 26) 2 0))  ;;
  )
  (setq w-hr (substr w-all 10 2)       ;; ["A" to "S"] >> "K"
        w-hr (chr (+ 64 (read w-hr)))  ;;
  )
  (setq w-mt (strcat (substr w-all 12 1) "-" (substr w-all 13 1)))  ;; ["00" to "59"] >> "4-2"
  (setq w-sc (substr w-all 14 2))  ;; ["00" to "59"] >> "34"
  (setq w-mm (substr w-all 16 2))  ;; ["00" to "59"] >> "89"
  (setq blkname (strcat "$" w-mn w-sc w-hr w-mt w-dy w-yr w-mm))  ;; >> "$J34K4-2V0489"
  (setvar "dimzin" o-dmzn)
  (princ)
)
;;;========================================================================
;;;========================================================================

(defun C:AB1 (/ ss i blk obj LL UR)
  (setq ss (ssget))
  (setq i 0)
  (setvar 'cmdecho 0)
  (command "_undo" "be")
  (repeat (sslength ss)
    (command "_.delay" 100)
    (Set_BlkName)
    (setq obj (vlax-ename->vla-object (setq blk (ssname ss i))))
    (vla-getboundingbox obj 'minpt 'maxpt)
    (setq
      LL (vlax-safearray->list minpt)  ;lower left point
      UR (vlax-safearray->list maxpt)  ;upper right point
    )
    ;(setq MPT (polar LL (angle LL UR) (/ (distance LL UR) 2))) ;midpoint of bounding box
    (command "-block" blkname "none" LL blk "")
    (command "-insert" blkname "none" LL 1 1 0)
    ;(prompt (strcat "\n   Block [" blkname "] Created. ")) ;alot of spam if enabled
    (setq i (1+ i))
  )
  (command "_undo" "e")
  (setvar 'cmdecho 1)
  (setq i (rtos i 2 0))
  (prompt (strcat "\n " i " Blocks Created. "))
  (princ)
)  ;end C:AB1

;;;========================================================================
;;;========================================================================

(defun C:AB2 ()
  (setq ss1 (ssget))
  (Set_BlkName)
  (setvar "attreq" 0)
  (setq ins-pt (getpoint "\nSpecify insertion base point: "))
  (if (null ins-pt) (setq ins-pt '(0 0)))
  (setvar "cmdecho" 0)
  (command "-block" blkname "none" ins-pt ss1 "")
  (command "-insert" blkname "none" ins-pt 1 1 0)
  (setvar "cmdecho" 1)
  (setvar "attreq" 1)
  (prompt (strcat "\n   Block [" blkname "] Created. "))
  (princ)
)  ;end C:WB2

;;;========================================================================
;;;========================================================================

 

Now selecting any entities with the new AB1 command will create that number of blocks automatically as shown below. Again be careful of what you select because anything will become a block. 6 poly lines and 3 text will become 9 individual blocks.

 

Edited September 25, 2020 by mhupp

[Prageeth]

Thank you...i also need another favor  i have two lisp so i want to combine them into one...

please check attachment thank you. From 1 lisp i want select object then with 2 lisp i want area text ..

 

1 ss.LSP 2 Hatch To Text.lsp

[mhupp]

Those seem to be above my programming level.

[marko_ribar]

On 9/26/2020 at 11:04 AM, Prageeth said:

Thank you...i also need another favor  i have two lisp so i want to combine them into one...

please check attachment thank you. From 1 lisp i want select object then with 2 lisp i want area text ..

 

What is it that that you don't understand in combining those 2 in one?

 

Small remark regarding "2 Hatch To Text.lsp"...

 

This line refering (setq)-ing :

...

(while

...

  (setq

  ...

  ...

  ad          (vla-get-ActiveDocument (vlax-get-acad-object))

  ) ; end (setq)

...

) ; end (while)

...

 

Is placed inside (while) looping, instructing routine to repeat unnedded (setq)-ing the same already set variable...

It is strongly recommended that you place setting "ad" variable at the beginnign of routine - just below (vl-load-com)...