Search the Community
Showing results for tags 'quantize'.
-
Quantise LISP works fine but makes hatch with quantised objects non-associative
3dwannab posted a topic in AutoLISP, Visual LISP & DCL
Here's the code originally written by David Forbus (Thank you btw). Any help will be appreciated in helping me to fix the hatch issue. Thanks. ;;; QUANTALL ;;; Written by David Forbus 09_dec_2008 ;;; QUANTALL prompts a user for a Quantize Value ;;; QUANTALL then prompts a user for a selection set and then ;;; modifies the INSERTION POINTS of TEXT, MTEXT, CIRCLES, BLOCKS, LINES and LWPOLYLINES within that selection set so they all "snap" to quantized coordinates. ;;; Modified by 3dwannab (get OSNAP settings) 14.06.02 (defun QUANTLN () (setq SP-X (/ (cadr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 10 CURENT)) QUANT-VALUE )) (setq EP-X (/ (cadr (assoc 11 CURENT)) QUANT-VALUE )) (setq EP-Y (/ (caddr (assoc 11 CURENT)) QUANT-VALUE )) (setq EP-Z (/ (cadddr (assoc 11 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (if (>= (- EP-X (fix EP-X)) 0.5) (setq EP-X (* QUANT-VALUE (+ 1.0 (fix EP-X)))) (setq EP-X (* QUANT-VALUE (fix EP-X)))) (if (>= (- EP-Y (fix EP-Y)) 0.5) (setq EP-Y (* QUANT-VALUE (+ 1.0 (fix EP-Y)))) (setq EP-Y (* QUANT-VALUE (fix EP-Y)))) (if (>= (- EP-Z (fix EP-Z)) 0.5) (setq EP-Z (* QUANT-VALUE (+ 1.0 (fix EP-Z)))) (setq EP-Z (* QUANT-VALUE (fix EP-Z)))) (setq CURENT (subst (list 10 SP-X SP-Y SP-Z) (assoc 10 CURENT) CURENT )) (setq CURENT (subst (list 11 EP-X EP-Y EP-Z) (assoc 11 CURENT) CURENT )) (entmod CURENT) ) (defun QUANTPOLY () (setq COUNTER2 1) (setq POLY-NEW (list)) (while (< COUNTER2 (length CURENT)) (setq VRTX-PNT (nth COUNTER2 CURENT)) (if (= 10 (car VRTX-PNT)) (progn (setq SP-X (/ (cadr VRTX-PNT) QUANT-VALUE )) (setq SP-Y (/ (caddr VRTX-PNT) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (setq POLY-NEW (append POLY-NEW (list (list 10 SP-X SP-Y))))) (if (= 330 (car VRTX-PNT)) nil (if (= 5 (car VRTX-PNT)) nil (setq POLY-NEW (append POLY-NEW (list VRTX-PNT)))) ) ) (setq COUNTER2 (+ COUNTER2 1)) ) (entmake POLY-NEW) (entdel CURENT-NAME) ) (defun QUANTREG () (setq SP-X (/ (cadr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 10 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 10 SP-X SP-Y SP-Z) (assoc 10 CURENT) CURENT )) (entmod CURENT) ) (defun QUANTXT () (setq TXT-HORZ (cdr (assoc 72 CURENT))) (setq TXT-VERT (cdr (assoc 73 CURENT))) (if (= TXT-HORZ 0) (if (= TXT-VERT 0) (progn (setq SP-X (/ (cadr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 10 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 10 SP-X SP-Y SP-Z) (assoc 10 CURENT) CURENT )) ) (progn (setq SP-X (/ (cadr (assoc 11 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 11 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 11 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 11 SP-X SP-Y SP-Z) (assoc 11 CURENT) CURENT )) ) ) (progn (setq SP-X (/ (cadr (assoc 11 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 11 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 11 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 11 SP-X SP-Y SP-Z) (assoc 11 CURENT) CURENT )) )) (entmod CURENT) ) (defun QUANTARC () (setq SP-X (/ (cadr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Y (/ (caddr (assoc 10 CURENT)) QUANT-VALUE )) (setq SP-Z (/ (cadddr (assoc 10 CURENT)) QUANT-VALUE )) (if (>= (- SP-X (fix SP-X)) 0.5) (setq SP-X (* QUANT-VALUE (+ 1.0 (fix SP-X)))) (setq SP-X (* QUANT-VALUE (fix SP-X)))) (if (>= (- SP-Y (fix SP-Y)) 0.5) (setq SP-Y (* QUANT-VALUE (+ 1.0 (fix SP-Y)))) (setq SP-Y (* QUANT-VALUE (fix SP-Y)))) (if (>= (- SP-Z (fix SP-Z)) 0.5) (setq SP-Z (* QUANT-VALUE (+ 1.0 (fix SP-Z)))) (setq SP-Z (* QUANT-VALUE (fix SP-Z)))) (setq CURENT (subst (list 10 SP-X SP-Y SP-Z) (assoc 10 CURENT) CURENT )) (setq RAD-R (/ (cdr (assoc 40 CURENT)) QUANT-VALUE )) (if (>= (- RAD-R (fix RAD-R)) 0.5) (setq RAD-R (* QUANT-VALUE (+ 1.0 (fix RAD-R)))) (setq RAD-R (* QUANT-VALUE (fix RAD-R)))) (setq CURENT (subst (cons 40 RAD-R) (assoc 40 CURENT) CURENT )) (entmod CURENT) ) (defun c:Fix_Quantize_All ( / osnap ) ;;3dwannab fix (setvar "cmdecho" 0) (setq OSNAP (getvar "osmode")) ;;3dwannab fix (setvar "osmode" 0) (setq QUANT-VALUE (getreal "\nEnter Quantize Value: ")) (setq SELECT-SET (ssget)) (setq COUNTER0 (1- (sslength SELECT-SET ))) (while (> COUNTER0 -1.0) (setq CURENT (entget (ssname SELECT-SET COUNTER0))) (setq CURENT-NAME (ssname SELECT-SET COUNTER0)) (if (= (cdr (assoc 0 CURENT)) "LINE") (QUANTLN)) (if (= (cdr (assoc 0 CURENT)) "TEXT") (QUANTXT)) (if (= (cdr (assoc 0 CURENT)) "MTEXT") (QUANTREG)) (if (= (cdr (assoc 0 CURENT)) "INSERT") (QUANTREG)) (if (= (cdr (assoc 0 CURENT)) "CIRCLE") (QUANTREG)) (if (= (cdr (assoc 0 CURENT)) "ARC") (QUANTARC)) (if (= (cdr (assoc 0 CURENT)) "LWPOLYLINE") (QUANTPOLY)) (setq COUNTER0 (1- COUNTER0)) ) (princ) (setvar "osmode" OSNAP) ) (princ "\nType \"Fix_Quantize_All\" to Quantize the INSERTION POINTS of TEXT, MTEXT, CIRCLES, ARCs, BLOCKS, LINES and LWPOLYLINES to the round off value.")