Scaling Polyline Contours

[Bill_Myron]

I have a great request. I need to scale some polyline contours from ground to grid coordinates. Using the scale comand this works, but the Z value is scaled as well. The thing is, I want to scale the X and Y only, not the Z.

So far the only way to do this is to create a block, scale it, then explode. This takes a lot of time that to me seems unnecessary.

So this is what I was thinking for a lisp routine that can do what I need.

Select a polyline (contours)
Scale the polyine to some factor.
Reset the Z value to the orginal value before scaling.

I hope this makes sense. Haha.

Anyone willing to tackle this?

[eldon]

Using the scale comand this works, but the Z value is scaled as well.
Anyone willing to tackle this?

If you scale the contours individually, then the Z value is not scaled.

Most people would probably scale the coordinates before they entered the data.

[BlackBox]

Look into vla-scaleEntity function.

[Bill_Myron]

eldon - The scale command scales the polyline uniformly. It applys the scale to all 3 axis. The data that was given to me was just the contour polylines. Therefore i can only use what was given.

Render man - Thanks for the start. Can this lisp be manipulated to only scale in the x and y directions and not the Z?

[Organic]

I have a great request. I need to scale some polyline contours from ground to grid coordinates.

Scaling contours like that is not a good practice in my opinion.

So far the only way to do this is to create a block, scale it, then explode. This takes a lot of time that to me seems unnecessary.

If this works and you only need to do it one off then why not just do this?

[BlackBox]

Render man - Thanks for the start. Can this lisp be manipulated to only scale in the x and y directions and not the Z?

What results did you get in your code testing?

[eldon]

The scale command scales the polyline uniformly. It applys the scale to all 3 axis.

Only if you scale about 0,0. If you scale each individual contour polyline about its own endpoint, the Z value is unaltered.

[marko_ribar]

(defun c:scpl ( / pt elev bpt entpl scf )
  (setq pt (getpoint "\nPick base point in XY plane for scaling your pline : "))
  (setq entpl (car (entsel "\nPick pline you want to scale")))
  (setq elev (cdr (assoc 38 (entget entpl))))
  (setq bpt (list (car pt) (cadr pt) elev))
  (setq scf (getreal "\nInput scale factor with or without decimal precision : "))
  (vl-cmdf "_.scale" entpl "" bpt scf)
(princ)
)

M.R.

[BlackBox]

(defun c:scpl ( / pt elev bpt entpl scf )
  (setq pt (getpoint "\nPick base point in XY plane for scaling your pline : "))
  (setq entpl (car (entsel "\nPick pline you want to scale")))
  (setq elev (cdr (assoc 38 (entget entpl))))
  (setq bpt (list (car pt) (cadr pt) elev))
  (setq scf (getreal "\nInput scale factor with or without decimal precision : "))
  (vl-cmdf "_.scale" entpl "" bpt scf)
(princ)
)

M.R.

I hope the user doesn't miss...

[BlackBox]

Slight revision to Marko's code (hope you don't mind):

(defun c:SCPL  () (c:ScalePlines))
(defun c:ScalePlines  (/ *error* nomutt oldNomutt ss pt scale)
  (princ "\rSCALE MULTIPLE POLYLINES ")
  (vl-load-com)

  (defun *error*  (msg)
    (and oldNomutt (setvar 'nomutt oldNomutt))
    (if acDoc (vla-endundomark acDoc))
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
    (princ))

  (defun nomutt (arg)
    (cond (oldNomutt)
          ((setq oldNomutt (getvar 'nomutt))))
    (if arg
      (setvar 'nomutt 1)
      (setvar 'nomutt 0)))
  
  (prompt "\nSelect multiple polylines to scale: ")
  (if (and (nomutt T)
           (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
           (nomutt nil)
           (setq pt (getpoint "\nSpecify base point: "))
           (setq scale (getreal "\nEnter scale factor: ")))
    ((lambda (acDoc / elev)
       (vla-startundomark acDoc)
       (vlax-for x  (setq ss (vla-get-activeselectionset acDoc))
         (setq elev (vla-get-elevation x))
         (vla-scaleentity x (vlax-3d-point pt) scale)
         (vla-put-elevation x elev))
       (vla-delete ss)
       (setvar 'nomutt oldNomutt)
       (vla-endundomark acDoc))
      (vla-get-activedocument (vlax-get-acad-object)))
    (cond (pt (prompt "\n** Scale factor required ** "))
          (ss (prompt "\n** Base point required ** "))
          ((prompt "\n** Nothing selected ** "))))
  (princ))