Jump to content

AUTO-BLOCK Improvement


Prageeth

Recommended Posts

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

                                                    Should  create 100 of block individually

 

Link to comment
Share on other sites

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 by mhupp
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

 

autoblock.png.0e289e0b81946c0779ca39475748366d.png

Edited by mhupp
Link to comment
Share on other sites

  • 1 year later...
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)...

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...