Jump to content
Bill_Myron

Scaling Polyline Contours

Recommended Posts

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?

Share this post


Link to post
Share on other sites
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. :o

Share this post


Link to post
Share on other sites
BlackBox

Look into vla-scaleEntity function. ;)

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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. 8)

Share this post


Link to post
Share on other sites
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. 8)

 

I hope the user doesn't miss... ;)

Share this post


Link to post
Share on other sites
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))

Edited by BlackBox
Revised code to allow selectionset, limit to LW*

Share this post


Link to post
Share on other sites
Bill_Myron
Only if you scale about 0,0. If you scale each individual contour polyline about its own endpoint, the Z value is unaltered.

 

Scaling needs to be done from 0,0. there is no other way to get from ground to grid coordinates.

 

 

Dink87522 - I agree that this is not the best practice. All I have to work with are contours so i have to adjust. The method of blocking > scaling > exploding is so time consuming. There are about 5000 polylines, and exploded there are around 300,000 lines. There is just not tenough memory to do it all at once, so I have to do it in small selections. very time consuming.

 

 

RenderMan - I tried your latest code. It stills cales the z value. This is what I ended up with everytime i tried anything.

 

marko_ribar - Thats the one!! It has worked!! Holy smokes that will save loads of time.

 

 

Now I wonder if it can be modified to select multple polylines at once.

Share this post


Link to post
Share on other sites
BlackBox

RenderMan - I tried your latest code. It stills cales the z value. This is what I ended up with everytime i tried anything.

...

Now I wonder if it can be modified to select multple polylines at once.

 

Code revised - now you can make one, single selection set of all your contours, and the entire selection set will be scaled from the same (user specified) base point. All elevations will remain the same as they were to start.

 

HTH

Share this post


Link to post
Share on other sites
Bill_Myron

That is amazing. That wouldve taken me years to figure out that code.

 

It works perfectly!! Does in seconds what takes me a whole day to do.

 

 

Thanks for all the help!

Share this post


Link to post
Share on other sites
BlackBox
That is amazing. That wouldve taken me years to figure out that code.

 

It works perfectly!! Does in seconds what takes me a whole day to do.

 

 

Thanks for all the help!

 

I'm happy to help. :)

 

That's very kind of you to say; Cheers! :beer:

Share this post


Link to post
Share on other sites
alanjt
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 . "*POLYLINE"))))
          (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))

You might want to limit this to LWPolylines, or retool it a bit.

Share this post


Link to post
Share on other sites
BlackBox
You might want to limit this to LWPolylines, or retool it a bit.

 

Thanks Alan :); code revised.

Share this post


Link to post
Share on other sites
alanjt
Thanks Alan :); code revised.

Bored...

 

(defun c:SLWP (/ *error* ss point elev)

 (defun *error* (msg)
   (and *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (vla-startundomark
   (cond (*AcadDoc*)
         ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
   )
 )

 (princ "\nSelect LWPolylines to scale: ")
 (if (and (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
          (setq point (getpoint "\nSpecify base point: "))
          (progn (initget 6)
                 (setq *SLWP:factor*
                        (cond ((getdist (strcat "\nSpecify scale factor"
                                                (if (numberp *SLWP:factor*)
                                                  (strcat " <" (rtos *SLWP:factor*) ">: ")
                                                  ": "
                                                )
                                        )
                               )
                              )
                              (*SLWP:factor*)
                        )
                 )
          )
     )
   (progn
     (setq point (vlax-3d-point (trans point 1 0)))
     (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
       (setq elev (vla-get-elevation x))
       (vla-scaleentity x point *SLWP:factor*)
       (vla-put-elevation x elev)
     )
     (vla-delete ss)
   )
 )
 (*error* nil)
 (princ)
)

Share this post


Link to post
Share on other sites
BlackBox
Bored...

 

Boredom... the 'real' mother of invention. :rofl:

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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...