Jump to content

Quantise LISP works fine but makes hatch with quantised objects non-associative

3dwannab

By 3dwannab
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

3dwannab Proficient

3dwannab

Posted
Posted

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.")

Link to comment
Share on other sites
  • 1 year later...
3dwannab Proficient

3dwannab

Posted
  • Author
Posted (edited)

I've found that it's the objects where there is a polyline as the hatch boundary.

 

 

From what I can see in the LISP it creates a new polyline therefore destroying the associated hatches. Is there a possibility to modify the polyline instead, like you can in the properties dialog?

 

 

sorry for the bump :)

vertex in polyline.jpg

Edited by 3dwannab
Link to comment
Share on other sites
3dwannab Proficient

3dwannab

Posted
  • Author
Posted (edited)

EDIT: this is not updating the hatch.

 

I don't know if this is a known bug but when this script runs the hatch doesn't come with it even if it still is associative.

 

Using manually the CONVERTPOLY command after works okay but I was wondering if it's possible within the LISP below.

 

OLD POST:

Got a different script here https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/round-xyz-by-decimal-precision/m-p/1231665#M171900 which does exactly what I want by not creating a new polyline and taking away hatch association. It uses the SNAPUNIT variable.

 

I slightly modified it so I can enter in the SNAPUNIT I want prior to running the command. Thanks to user bruno.valsecchi on the other forum.

 

It works on the following:

 "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE"


(defun round_number (xr n / )
   (* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n))
)
(defun c:Fix_Round_Numbers ( / js n_count ent dxf_ent dxf_lst)

(setq su (getvar 'SNAPUNIT))
(princ "Enter the tolerance in X,Y...\n")
(command "SNAPUNIT" pause "")
(setq js (ssget '((0 . "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE"))) n_count -1)
(cond
   (js
   (setvar "cmdecho" 0)
   (command "_.undo" "_group")
       (while (setq ent (ssname js (setq n_count (1+ n_count))))
       (setq dxf_ent (entget ent))
       (cond
           ((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
               (setq dxf_lst (cdr dxf_ent) dxf_ent (list (car dxf_ent)))
               (while (cdr dxf_lst)
                   (if (eq 10 (caar dxf_lst))
                       (setq dxf_ent (cons (cons 10 (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdar dxf_lst) (getvar "SNAPUNIT"))) dxf_ent))
                       (setq dxf_ent (cons (car dxf_lst) dxf_ent))
                   )
                   (setq dxf_lst (cdr dxf_lst))
               )
               (setq dxf_ent (reverse dxf_ent))
           )
           ((eq (cdr (assoc 0 dxf_ent)) "POLYLINE")
               (while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX")
                   (setq dxf_ent (subst (cons 10 (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdr (assoc 10 dxf_ent)) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT")))))) (assoc 10 dxf_ent) dxf_ent))
                   (entmod dxf_ent)
               )
           )
           (T
               (foreach n dxf_ent
                   (if (member (car n) '(10 11 12 13 40))
                       (if (listp (cdr n))
                           (setq dxf_ent (subst (cons (car n) (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdr n) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT")))))) (assoc (car n) dxf_ent) dxf_ent))
                           (setq dxf_ent (subst (cons (car n) (round_number (cdr n) (/ 1 (car (getvar "SNAPUNIT"))))) (assoc (car n) dxf_ent) dxf_ent))
                       )
                   )
               )
           )
       )
       (entmod dxf_ent)
       (entupd ent)
   )
   (command "_.undo" "_end")
   (setvar "cmdecho" 1)
   (setvar "SNAPUNIT" su)
   (princ (strcat "\n" (itoa n_count) " transformed objects (s)."))
   )
   (T (princ "\nNo found valid object ."))
)
(prin1)
) 
)

Edited by 3dwannab
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...