Block Scale and the Divide Command

[CADdancer]

Hello to All AUGI Members:

I have a lisp routine that uses the "divide" command to place blocks along the lenght of a polyline. The blocks are inserted at an "x" and "y" scale of "1" because the "divide" command provides no option to vary the block scale.

With this lisp routine, is there a way to change the block scale for all of the blocks that were inserted using this routine. For example, all of the blocks that were inserted with the "x" and "y" scale of "1" would now have an "x" and "y" scale of "12".

I would like to accomplish with the lisp routine and not have to select all of the inserted blocks and use the properties window to change the "x" and "y" block scale.

Any assistance would be appreciated.

Regards,
Vince

[matt.worland]

Can you post the code

[CADdancer]

Matt:

Here is an example of the simple code used to place the blocks>

;;;;;;START CODE

(defun C:InsBk ()

(SETQ RKSPA (GETSTRING "\n...Enter Number of Block Spaces..."))
(PROMPT "\n...")
(setq B1 (entget (car (entsel "\n...Select Polyline to Add Blocks..."))))

(setq B2 (cdr (assoc -1 B1)))

(SETQ DRok (TBLSEARCH "BLOCK" "Myblock"))
(IF (= DRok NIL)
(COMMAND "-INSERT" "Myblock" "_NON" "0,0" "1" "1" "0"))

(setq EEB (ssget "L"))

(COMMAND "DIVIDE" B2 "BLOCK" "Myblock" "Y" RKSPA)

(COMMAND "ERASE" EEB "")
)

;;;;;;;;END CODE

I hope this is what you are looking for....?

Any assistance would be appreciated.

Regards,
Vince

[matt.worland]

I am kinda busy right now to write that code. If I do not see a post fixing this I will write it when I get a chance.

Matt

[RobertB]

Mark (setq lastent (entlast)) the last entity in the drawing before starting the divide. After the divide, use (entnext lastent) in a loop, check to see if the ent is the block, if so, scale it up.

[matt.worland]

This is what I came up with before I read Robert's nice and efficient code.


(defun C:InsBk (/ RKSPA objDivideline intXScale intYScale entSS intCount objInsert)
(setq RKSPA (getstring "\n...Enter Number of Block Spaces..."))
(prompt "\n...")
(setq objDivideline (cdr (assoc -1 (entget (car (entsel "\n...Select Polyline to Add Blocks..."))))))
(setq intXScale (cond ((getreal "\nInsertion X scale factor <1>: "))
(t 1.0)
)
)
(setq intYScale
(cond ((getreal (strcat "\nInsertion Y scale factor/<X = "
(rtos intXScale) ">: ")))
(t "X")))
(cond ((eq intYScale "X")
(setq intYScale intXScale)))
(if (= (tblsearch "BLOCK" "MYBLOCK") NIL)
(progn
(command "-INSERT" "MYBLOCK" /E)
)
)
(command "DIVIDE" objDivideline "BLOCK" "MYBLOCK" "Y" RKSPA)
(cond
((not (setq entSS (ssget "P")))
(princ "\nNothing Inserted! ")
)
((repeat (setq intCount (sslength entSS))
(setq intCount (1- intCount))
(setq objInsert (vlax-ename->vla-object (ssname entSS intCount)))
(vlax-put-property objInsert 'XScaleFactor intXscale)
(vlax-put-property objInsert 'YScaleFactor intYScale)
)
)
)
)

[matt.worland]

Here is another version using Robert's suggestion




(defun C:InsBk (/ strSections objDivideline strBlock intXScale intYScale lastent nextent objInsert)
(setq strSections (getstring "\n...Enter Number of Block Spaces: "))
(setq objDivideline (cdr (assoc -1 (entget (car (entsel "\nSelect Polyline to Add Blocks: "))))))
(setq strBlock (getstring "\nEnter Block Name: "))
(setq intXScale (cond ((getreal "\nInsertion X scale factor <1>: "))
(t 1.0)))
(setq intYScale (cond ((getreal (strcat "\nInsertion Y scale factor/<X = "
(rtos intXScale 2 0) ">: ")))
(t "X")))
(cond ((eq intYScale "X")
(setq intYScale intXScale)))
(if (= (tblsearch "BLOCK" strBlock) NIL)
(progn (command "-INSERT" strBlock /E)))
(setq lastent (entlast))
(command "DIVIDE" objDivideline "BLOCK" strBlock "Y" strSections)
(setq nextent (entnext lastent))
(while (and nextent (=(cdr(cadr(entget nextent))) "INSERT"))
(setq objInsert (vlax-ename->vla-object nextent))
(vlax-put-property objInsert 'XScaleFactor intXscale)
(vlax-put-property objInsert 'YScaleFactor intYScale)
(setq nextent (entnext nextent))
)
(princ)
)


HTH,
Matt

[CADdancer]

Matt:

I just wanted to take a minute to thank you for the help you provided with the scaling of blocks and the divide command.

Your code works exactly the way I wanted it to.

Thanks Again,
Vince

[matt.worland]

Vince,


Anytime. I am glad to be able to help.

Your Welcome,
Matt

[peter]

Well you had to figure I would jump in here sometime. :)

I was thinking of the creation of a general solution for inserting blocks into drawings. Most all of the time inserts are placed on the same layer and at the same size as all of the rest of them in a drawing. Right?

So for a general solution. (my thought is) have an acdb reactor watch for insertion of blocks. If one is inserted, find the other instances of that block in the database and change the new one to be like the others. Sound simple enough?

Tell me what you think.

Peter Jamtgaard



; copr 2004 Peter Jamtgaard
; Reactor to change new instaces of inserts to be like existing instances
;***********************************************************************


; Command to start reactor(s)
; Initialize new list of appended blocks to nil

(defun CommandWillStart (evtReactor lstCallback)
(cond ((wcmatch (car lstCallback) "INSERT,MINSERT,EXPLODE,DIVIDE,MEASURE")
(setq lstACDBBlockObjects nil))))

;**********************************************************************
; Database Insert Append reactor(s)
; Create a list of newly appended inserts

(defun ACDBInsertAppend (evtReactor lstCallback)
(cond ((wcmatch (vla-get-objectname
(setq objBlock (vlax-ename->vla-object
(cadr lstCallback))))
"AcDbBlockReference,AcDbMInsertBlock")
(if (not (member objBlock lstACDBBlockObjects))
(setq lstACDBBlockObjects (cons objBlock lstACDBBlockObjects))))))

;*********************************************************************
; Command Ended Reactor(s)
; Switch Layer of members of the newly created blocks

(defun CommandEnded (evtReactor lstCallback / lstBlocks ssBlocks )
(cond ((and (wcmatch (car lstCallback) "INSERT,MINSERT,EXPLODE,DIVIDE,MEASURE")
lstACDBBLockObjects)
(foreach objBLock lstACDBBLockObjects
(if (setq lstBlocks (FindBlocks (vla-get-activedocument
(vlax-get-acad-object)
)
(vla-get-name objBlock)
)
)
(progn
(vla-put-layer objBlock
(vla-get-layer
(nth 0 lstBlocks)
)
)
(vla-put-xscalefactor objBlock (vla-get-xscalefactor
(nth 0 lstBlocks)
)
)
(vla-put-yscalefactor objBlock (vla-get-yscalefactor
(nth 0 lstBlocks)
)
)
(vla-put-zscalefactor objBlock (vla-get-zscalefactor
(nth 0 lstBlocks)
)
)
)
)
)
(setq lstACDBBlockObjects nil))))

;*********************************************************************
; Routine returns a list of block objects that match the strBlockName
; Argument

(defun FindBlocks (objDocument strBlockName / lstBlocks)
(vlax-for colLayouts (vla-get-layouts objDocument)
(vlax-for objBlockItem (vla-get-block colLayouts)
(if (and (wcmatch (vla-get-objectname objBlockItem)
"AcDbBlockReference,AcDbMInsertBlock")
(= (strcase (vla-get-name objBlockItem))
(strcase strBlockName)))
(setq lstBlocks (cons objBlockItem lstBlocks)))))
(if lstBlocks (reverse lstBlocks)))

;Initiate Reactor on loading
(setq rxnCommand (vlr-editor-reactor
nil
'((:vlr-commandWillStart . CommandWillStart)
(:vlr-commandEnded . CommandEnded)))
rxnInsertAppend (vlr-acdb-reactor
nil
'((:vlr-objectAppended . ACDBInsertAppend )))
)

[matt.worland]

Works great!
Nice idea.
Thanks

[Voaraghamanthar]

Really like this feature you created. Nice work.
When I draw though, I find that I copy and paste a lot of blocks to and from drawings, which would bypass this method. Would it be difficult to pick up pasted objects as well?