对Marko的代码进行了轻微修改(希望您不介意):
- (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))
|