[编程交流] 缩放多段线等高线

(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)
)