Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/25/2024 in all areas

  1. If this might interest you, try this. This is for a metric system with multiple sizes of A4. The first use can be confusing, but don't hesitate to move the pointer, if you don't see anything change scale with the + or - keys, or zoom / zoom out with the wheel. Lines 157 and 158 can be commented out if you want to do other things with the data or continue with your own code... (defun des_vec (lst col / lst_sg) (setq lst_sg (list (cadr lst) (car lst))) (setq lst (cdr lst)) (while lst (if (cadr lst) (setq lst_sg (cons (cadr lst) (cons (car lst) lst_sg))) (setq lst_sg (cons (last lst_sg) (cons (car lst) lst_sg))) ) (setq lst (cdr lst)) ) (setq lst_sg (cons col lst_sg)) (grvecs lst_sg) ) (defun c:A4_dyn ( / unit_draw hview old_snapang pt_ins dx dy pt_tmp ang l_scale format_scale coeff key pt_key n nb_column nb_raw pt_row count s_ang) (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz"))) (progn (initget "KM ME CM MM") (if (not(setq unit_draw (getkword "\nDrawing made in [KM/ME/CM/MM] <ME>: "))) (setq unit_draw "ME") ) (cond ((eq unit_draw "KM") (setq unit_draw 1000000) ) ((eq unit_draw "ME") (setq unit_draw 1000) ) ((eq unit_draw "CM") (setq unit_draw 10) ) ((eq unit_draw "MM") (setq unit_draw 1) ) ) (setvar "USERS5" (strcat "qz" (itoa unit_draw))) ) (setq unit_draw (atoi (substr (getvar "USERS5") 3))) ) (setq hview (getvar "VIEWSIZE") old_snapang (getvar "SNAPANG") pt_ins (list (- (car (getvar "VIEWCTR")) (* hview 0.5)) (- (cadr (getvar "VIEWCTR")) (* hview 0.5))) dx 210.0 dy (* 210.0 (sqrt 2)) pt_tmp pt_ins ang (getvar "SNAPANG") l_scale '(1.0 1.25 2.0 2.5 5.0 7.5) format_scale (car l_scale) coeff 1.0 ) (if (> (fix (/ hview dy)) 3) (while (> (fix (/ hview dy)) 3) (foreach value l_scale (if (> (fix (/ hview dy)) 3) (setq format_scale value dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale)) ) ) (if (> (fix (/ hview dy)) 3) (setq coeff (* coeff 10.0) l_scale (mapcar '(lambda (x) (* x coeff)) l_scale) format_scale (car l_scale) ) ) ) ) (if (< (fix (/ hview dy)) 1) (while (< (fix (/ hview dy)) 1) (foreach value (reverse l_scale) (if (< (fix (/ hview dy)) 1) (setq format_scale value dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale)) ) ) (if (< (fix (/ hview dy)) 1) (setq coeff (* coeff 0.1) l_scale (mapcar '(lambda (x) (* x coeff)) l_scale) format_scale (last l_scale) ) ) ) ) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: ")) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (setq pt_key (cadr key)) (setq n (* (setq nb_column (fix (/ (+ (* (- (car pt_key) (car pt_ins)) (cos ang)) (* (- (cadr pt_key) (cadr pt_ins)) (sin ang))) dx))) (setq nb_raw (fix (/ (- (* (- (cadr pt_key) (cadr pt_ins)) (cos ang)) (* (- (car pt_key) (car pt_ins)) (sin ang))) dy))) ) pt_row pt_ins count 0 ) (redraw) (repeat n (des_vec (list (list (car pt_ins) (cadr pt_ins)) (list (+ (car pt_ins) (* dx (cos ang))) (+ (cadr pt_ins) (* dx (sin ang)))) (setvar "LASTPOINT" (list (+ (car pt_ins) (- (* dx (cos ang)) (* dy (sin ang)))) (+ (cadr pt_ins) (+ (* dy (cos ang)) (* dx (sin ang)))) ) ) (list (- (car pt_ins) (* dy (sin ang))) (+ (cadr pt_ins) (* dy (cos ang)))) ) 3 ) (setq count (1+ count)) (if (< count nb_column) (setq pt_ins (list (+ (car pt_ins) (* dx (cos ang))) (+ (cadr pt_ins) (* dx (sin ang))))) (setq pt_ins (list (- (car pt_row) (* dy (sin ang))) (+ (cadr pt_row) (* dy (cos ang)))) pt_row pt_ins count 0) ) ) (setq pt_ins pt_tmp) ) ((or (eq (cadr key) 114) (eq (cadr key) 82)) (initget 0) (setq s_ang (getorient pt_ins (strcat "\nNew angle<" (angtos (getvar "SNAPANG")) ">: " ) ) ) (if (not s_ang) (setq s_ang ang)) (if (and (> s_ang (/ pi 2)) (<= s_ang (/ (* 3 pi) 2))) (setq ang (+ s_ang pi)) (setq ang s_ang) ) (setvar "SNAPANG" ang) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale" (rtos (* unit_draw format_scale) 2 3) ">: ")) ) ((or (eq (cadr key) 109) (eq (cadr key) 77)) (initget 9) (setq pt_ins (getpoint "\nSpecify the bottom left corner: ")) (setq pt_ins (list (car pt_ins) (cadr pt_ins)) pt_tmp pt_ins) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: ")) ) ((eq (cadr key) 43) (setq format_scale (cadr (member format_scale l_scale))) (if (not format_scale) (setq format_scale (car (setq l_scale (mapcar '(lambda (x) (* x 10.0)) l_scale))))) (setq dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale)) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: ")) ) ((eq (cadr key) 45) (setq format_scale (cadr (member format_scale (reverse l_scale)))) (if (not format_scale) (setq format_scale (last (setq l_scale (mapcar '(lambda (x) (* x 0.1)) l_scale))))) (setq dx (* 210.0 format_scale) dy (* 210.0 (sqrt 2) format_scale)) (princ (strcat "\nSpecify top right corner or [R] to rotate, [M] to move, [+/-] to scale <" (rtos (* unit_draw format_scale) 2 3) ">: ")) ) ) ) (princ "\n") (redraw) (princ (setq toto (list (list pt_ins (getvar "LASTPOINT")) (getvar "SNAPANG") (* unit_draw format_scale)))) (command "_.rectang" "_none" (caar toto) "_rotation" (angtos (getvar "SNAPANG")) "_none" (cadar toto)) (setvar "SNAPANG" old_snapang) (prin1) )
    1 point
  2. Try the following instead: (defun c:ason nil (asremove) (vlr-command-reactor "autosave" '( (:vlr-commandwillstart . autosave) (:vlr-commandended . autosave) (:vlr-commandcancelled . autosave) (:vlr-commandfailed . autosave) ) ) (setq autosave-count 0) (princ "\n<<< AutoSave reactor Switched ON >>>") (princ) ) (defun c:asoff nil (asremove) (princ "\n<<< AutoSave reactor Switched OFF >>> ") (princ) ) (defun asremove nil (foreach obj (cdar (vlr-reactors :vlr-command-reactor)) (if (= "autosave" (vlr-data obj)) (vlr-remove obj) ) ) ) (defun autosave ( obj arg ) (if (and (not (wcmatch (strcase (car arg)) "*UNDO")) (numberp autosave-count) (zerop (rem (setq autosave-count (1+ autosave-count)) 20)) (= 1 (getvar 'dwgtitled)) ) (vla-save (asdoc)) ) (princ) ) (defun asdoc nil (eval (list 'defun 'asdoc nil (vla-get-activedocument (vlax-get-acad-object)))) (asdoc) ) ( (lambda nil (vl-load-com) (cond ( (wcmatch (strcase (getvar 'dwgprefix)) (strcat (strcase (getenv "TempDirectory")) "*"))) ( (= 6 (acet-ui-message "Turn AutoSave On? " "**ALERT**" (logior Acet:YESNO Acet:ICONWARNING))) (c:ason) (ALERT "AutoSave is turned on \nType ASOFF to disable") ) ( (c:asoff) (ALERT "AutoSave is turned off \nType ASON to enable") ) ) (princ) ) )
    1 point
×
×
  • Create New...