Code Red > AutoLISP (Vanilla / Visual)
scale image from center
PM:
I find and this code for center scale
--- Code - Auto/Visual Lisp: ---;; ScaleAboutCenters.lsp [command name: SAC];; To Scale multiple objects, each About its own Center, by the same User-specified;; scale factor.;; Uses the middle of each object's bounding box as the base point for scaling, to;; keep objects centered at approximately the same position in the drawing.;; [For Mtext, that will be based on the defined Mtext box width, not the extents;; of the content; for a Block or Text, the center of its extents in the drawing, not;; its insertion point; for an Arc, the center of its extents, not its geometric center;;; some entity types' (e.g. Spline's) bounding box can sometimes reach beyond;; its extents and affect results slightly.];; Rejects selection of objects on locked Layers, or without a "center" [Rays, Xlines].;; Stores scale factor; offers as default on subsequent use in same editing session.;; Kent Cooper, 6 May 2014 (defun C:SAC (/ *error* cmde ss inc ent) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ); end if (command "_.undo" "_end") (setvar 'cmdecho cmde) (princ) ); end defun - *error* (setq cmde (getvar 'cmdecho)) (setvar 'cmdecho 0) (command "_.undo" "_begin") (setq *SACscl (cond ( (getreal (strcat "\nEnter Scale Factor <" (if *SACscl (rtos *SACscl 2 4) "1"); offer default: prior value / 1 on first use ">: " ); strcat ); getreal ); User-input condition (*SACscl); Enter on subsequent use [prior value] (1); Enter on first use ); cond & *SACscl ss (ssget ":L" '((-4 . "<NOT") (0 . "RAY,XLINE") (-4 . "NOT>"))) ;; not objects on Locked Layers or without finite extents ); setq (repeat (setq inc (sslength ss)) (setq ent (ssname ss (setq inc (1- inc)))) (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt) (command ".scale" ent "" "_none" (mapcar '/ ; midpoint of bounding box (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2 2) ); mapcar *SACscl ); command ); repeat (command "_.undo" "_end") (setvar 'cmdecho cmde) (princ)); defun(vl-load-com)(prompt "\nType SAC to Scale objects About each one's Center.")
BIGAL:
This replaces all the (setq *SACscl code 27-42 just add more scales as you want.
--- Code: ---(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (not but)(setq but 1))
(setq *SACscl (atof (ah:butts but "V" '("Choose scale 1:X " " 1" " 500" " 1000" " 2000" " 5000" ))))
(setq ss (ssget ":L" '((-4 . "<NOT") (0 . "RAY,XLINE") (-4 . "NOT>"))))
;; not objects on Locked Layers or without finite extents
--- End code ---
PM:
Hi BIGAL. I prefer to convert
this
--- Code - Auto/Visual Lisp: ---(defun c:myimgscale (/) (TEXTPAGE) (princ "\n")(princ "\n")(princ "\n")(progn (initget "1 2 3") (setq l (cond ((getkword "\nslelect image 1:1 : 1. for scale 1:500. 2. for scale 1:1000. 3. for scale 1:5000. " ) ) ("1") ) ) (if (eq l "1") ((lambda (/ ent) (while (not (setq ent (car (entsel))))) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 2) );end wile ); end lambda ); end if (if (eq l "2") ((lambda (/ ent) (while (not (setq ent (car (entsel))))) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 1) );end wile ); end lambda ); end if ((lambda (/ ent) (while (not (setq ent (car (entsel))))) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 0.2) );end wile ); end lambda ); end if ) ; end if
with
--- Code - Auto/Visual Lisp: --- ;; ScaleAboutCenters.lsp [command name: SAC] ;; To Scale multiple objects, each About its own Center, by the same User-specified ;; scale factor. ;; Uses the middle of each object's bounding box as the base point for scaling, to ;; keep objects centered at approximately the same position in the drawing. ;; [For Mtext, that will be based on the defined Mtext box width, not the extents ;; of the content; for a Block or Text, the center of its extents in the drawing, not ;; its insertion point; for an Arc, the center of its extents, not its geometric center; ;; some entity types' (e.g. Spline's) bounding box can sometimes reach beyond ;; its extents and affect results slightly.] ;; Rejects selection of objects on locked Layers, or without a "center" [Rays, Xlines]. ;; Stores scale factor; offers as default on subsequent use in same editing session. ;; Kent Cooper, 6 May 2014 (defun C:SAC (/ *error* cmde ss inc ent) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ); end if (command "_.undo" "_end") (setvar 'cmdecho cmde) (princ) ); end defun - *error* (setq cmde (getvar 'cmdecho)) (setvar 'cmdecho 0) (command "_.undo" "_begin") (setq *SACscl (cond ( (getreal (strcat "\nEnter Scale Factor <" (if *SACscl (rtos *SACscl 2 4) "1"); offer default: prior value / 1 on first use ">: " ); strcat ); getreal ); User-input condition (*SACscl); Enter on subsequent use [prior value] (1); Enter on first use ); cond & *SACscl ss (ssget ":L" '((-4 . "<NOT") (0 . "RAY,XLINE") (-4 . "NOT>"))) ;; not objects on Locked Layers or without finite extents ); setq (repeat (setq inc (sslength ss)) (setq ent (ssname ss (setq inc (1- inc)))) (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt) (command ".scale" ent "" "_none" (mapcar '/ ; midpoint of bounding box (mapcar '+ (vlax-safearray->list minpt) (vlax-safearray->list maxpt)) '(2 2 2) ); mapcar *SACscl ); command ); repeat (command "_.undo" "_end") (setvar 'cmdecho cmde) (princ) ); defun (vl-load-com) (prompt "\nType SAC to Scale objects About each one's Center.")
Thanks
BIGAL:
A hidden part of the multi radio button is look at variable BUT it is which button number is picked so you can have your 1. 1:1, 2. 1:200
Just do the code above then type !but you will see a number appear that matches the button picked. You dont need the (setq ans if you use the but value.
(ah:butts but "V" '("Choose scale 1:X " "1. 1" "2. 500" "3. 1000" "4. 2000" "5. 5000" ))
Also
--- Code: ---(while (not (setq ent (car (entsel "\npick entity ")))))
(cond
((= but 1) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 1.0))
((= but 2) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 2.0))
((= but 3) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 0.2))
)
--- End code ---
PM:
BIGAL i want to ask something. When i choose a scale the window close before i press OK is it possible to fix it?
--- Code - Auto/Visual Lisp: ---(defun c:test (/) (if (not AH:Butts)(load "Multi Radio buttons.lsp"))(if (not but)(setq but 1))(setq *testscl (atof (ah:butts but "V" '("Choose scale 1:X" "1. 1:500" "2. 1:1000" "3. 1:5000")))) (while (not (setq ent (car (entsel "\npick entity ")))))(cond ((= but 1) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 2.0)) ((= but 2) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 1.0)) ((= but 3) (command "_scale" ent "" (cdr (assoc 11 (entget ent))) 0.2)) ) ) ; Multi button Dialog box for a single choice repalcment of initget; By Alan H Feb 2019 info@alanh.com.au ; Example code as the radio button click will close the default button setting is required ; It will remember what button ws pressed if ran again with same request. ; You can have "H" horizontal or "V" vertical for DCL. ; a=97 A=65 1=49 0=48; example make an options list a-h 97 then 8 more.; (if (not AH:Butts)(load "Multi Radio buttons.lsp")); (if (not but)(setq but 1)); (setq ans2 (ah:butts 1 "v" (make_letters "Please choose" 97 8))) ; (if (not AH:Butts)(load "Multi radio buttons.lsp")) ; loads the program if not loaded already; (if (not but)(setq but 1)) ; this is needed to set default button ; you can reset default button to user pick; (if (not AH:Butts)(load "Multi Radio buttons.lsp")); (if (not but)(setq but 1)); (setq ans (substr (ah:butts but "V" '("Choose colour to remain " " 1" " 2" " 3" " 4" " 5" " 6" " 7")) )) ; spaced characters; or just use "but" value and compare to a list; ans holds the button picked value as a string ; if you want ans a number use (atof ans) or (atoi ans) ;(if (not AH:Butts)(load "Multi Radio buttons.lsp"));(if (= but nil)(setq but 1));(setq ans (ah:butts but "h" '("Yes or No" "Yes" "No"))) ; ans holds the button picked value ; (if (not AH:Butts)(load "Multi Radio buttons.lsp")); (if (= but nil)(setq but 1)); (setq ans (atoi(ah:butts but "V" '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")))) ; ans holds the button picked as an integer value (defun make_letters (heading asc numch / lstchar) (if (/= heading nil)(setq lstchar (list heading))(setq lstchar '()))(repeat numch (setq lstchar (cons (chr asc) lstchar))(setq asc (+ asc 1)))(setq lstchar (reverse lstchar))(princ lstchar)) (defun AH:Butts (AHdef verhor butlst / fo fname x k numch asc)(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"));(setq fo (open (setq fname "D:\\acadtemp\\test.dcl") "w"))(write-line "AHbutts : dialog {" fo)(write-line (strcat " label =" (chr 34) (nth 0 butlst) (chr 34) " ;" )fo)(write-line " : row {" fo)(if (= (strcase verhor) "V")(progn(write-line " : boxed_radio_column {" fo)(write-line (strcat " width = " (rtos (+ (strlen (nth 0 butlst)) 10) 2 0) " ;") fo) ; increase 10 if label does not appear)(write-line " : boxed_radio_row {" fo))(setq x 1)(setq numch (length butlst))(repeat (- numch 1) (write-line " : radio_button {" fo)(write-line (strcat "key = " (chr 34) "Rb" (rtos x 2 0) (chr 34) ";") fo)(write-line (strcat "label = " (chr 34) (nth x butlst) (chr 34) ";") fo)(write-line " }" fo);(if (or (= numch nil) (< numch 8))(write-line "spacer_1 ;" fo);)(setq x (+ x 1)))(write-line " }" fo)(write-line " }" fo)(write-line "spacer_1 ;" fo)(write-line " ok_only;" fo)(write-line " }" fo)(close fo)(setq dcl_id (load_dialog fname))(if (not (new_dialog "AHbutts" dcl_id) )(exit))(setq x 1)(repeat (- (length butlst) 1)(setq k (strcat "Rb" (rtos x 2 0)))(action_tile k (strcat "(setq but " (rtos x 2 0) ")" "(done_dialog)"))(if (= ahdef x)(set_tile k "1"))(setq x (+ x 1)))(action_tile "accept" (strcat "(setq but " (rtos ahdef 2 0) ")" "(done_dialog)"))(start_dialog)(unload_dialog dcl_id)(vl-file-delete fname)(nth but butlst) ) ; end defun
Thanks
Navigation
[0] Message Index
[#] Next page
[*] Previous page
Go to full version