Scale with different X, Y, Z scale factors - Ellipse

[Steven P]

This is one that came up this week, wondering if anyone has anything they can share:

 

They want to explode a block with different X and Y scales - all good except polylines appear also get exploded unless the X & Y scales are equal. Not a problem to create a function for lines and polylines to explode and retain polylines as polylines. Now onto the others..... Text, mtext and nested blocks are just trigonometry to adjust the UCS X and Y but ellipse....

 

I could make a block the ellipses, scale x-y then explode, which is the usual method, easy enough... but why go easy....

 

So question - does anyone have a LISP that can scale / stretch an ellipse along a single axis only?

[CyberAngel]

Thinking out loud: could you override the Explode function, pull out the polylines and ellipses, and pass everything else to the normal Explode? You'd have to redraw the polylines and ellipses, but you have their positions and scales from the block definition. Or you could pass the other objects directly to model space and erase the block.

[Steven P]

Could do - this is a work in progress and part 2 of his original problem - moving and scaling a set of objects from one coordinate system to another (mapping). It is just the polyline that he was having problems with so might be a better solution, take them out, scale, explode block.

[Steven P]

Thanks - this way works, explodes a non-uniformly scaled block and retains polylines as polylines.

 

Not enough hours this week to go my other way and modify each entity to the scales - still might be curious later on how to adjust ellipses though - might come back again in the future.

 

(defun c:exp2 ( / )
  (defun blockcomponents ( blk / ent rtn ) ;return list of bloc components, entity names, ref. Lee Mac
    (if (setq ent (tblobjname "block" blk))
        (while (setq ent (entnext ent))
            (setq rtn (cons ent rtn))
        )
    )
    (reverse rtn)
  )
  (defun mAssoc (key lst /) ; return list of 'key' dotted pair values, ref. Lee Mac mAssoc
   (mapcar 'cdr (vl-remove-if-not (function (lambda (item) (= key (car item)))) lst))
  )

  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)) ) ; acad object name for VLA-
  (setq acad_blocks (vla-get-blocks thisdrawing) ) ; acad object name for VLA-

  (setq MyBlock (car (entsel "Block: "))) ; Select a block. No error checking done.
  (setq MyEnt (entget MyBlock))           ; Block enity definition

;;get block details
  (setq BlName (cdr (assoc 2 (entget MyBlock)))) ; Block name
  (setq xscale (cdr (assoc 41 MyEnt)))           ; scale
  (setq yscale (cdr (assoc 42 MyEnt)))           ; scale
  (setq zscale (cdr (assoc 43 MyEnt)))           ; scale
  (setq Origin (cdr (assoc 10 MyEnt)))           ; insert point
  (setq Rotation (* (/ (cdr (assoc 50 MyEnt)) pi ) 180)) ; Degrees
  (setq Blentities (blockcomponents BlName))             ; entity list entities in block

;;;Undo Mark
  (vla-startundomark thisdrawing)

  (foreach n BlEntities                    ; Loop through block entities
    (setq BlEnt (entget n))                ; 'n; Entity definition
    (setq EntType (cdr (assoc 0 BlEnt)))   ; 'n' entity type
    (if (= (strcase EntType) "LWPOLYLINE") ; if 'n' is polyline
      (progn
        (setq LWCoords (mAssoc 10 BlEnt))                      ; get polyline coordinates
        (foreach m LWCoords                                    ; Loop through coordinates
          (setq NP (mapcar '* (list xscale yscale zscale) m))  ; Scale coordinate point
          (setq NP (mapcar '+ NP Origin))                      ; Move to block origin
          (setq BlEnt (subst (cons 10 NP) (cons 10 m) BlEnt )) ; modify LWPolyline definition to this coord.
        )
        (entmakex BlEnt)                         ; Create new polyline
        (vla-delete (Vlax-ename->vla-object n )) ; Delete polylines from block
      ) ; end progn
    ) ; end if
  ) ; end foreach
  (vla-regen acad_doc acallviewports) ; regen block

  (command "explode" MyBlock)   ; Explode block. Use Burst?

  (vla-endundomark thisdrawing) ; End undo
  (princ)                       ; Exit quietly
)