Quantise LISP工作正常，但m

3dwannab · 发表于 2022-7-5 17:48:59

这是David Forbus最初编写的代码（顺便说一句，谢谢）。如果能帮我解决舱口问题，我们将不胜感激。谢谢

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

3dwannab · 发表于 2022-7-5 18:47:23

我发现是有一条多段线作为图案填充边界的对象。

从LISP中可以看出，它创建了一条新的多段线，因此破坏了相关的图案填充。是否可以像在“属性”对话框中那样修改多段线？

抱歉撞到你了

3dwannab · 发表于 2022-7-5 19:11:25

编辑：这不是更新图案填充。

我不知道这是否是一个已知的错误，但当这个脚本运行时，图案填充不会随它一起出现，即使它仍然是关联的。

之后手动使用CONVERTPOLY命令可以正常工作，但我想知道是否可以在下面的LISP中使用。

旧帖子：
这里有不同的脚本https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/round-xyz-by-decimal-precision/m-p/1231665#M171900这正是我想要的，不创建新的多段线并去掉图案填充关联。它使用SNAPUNIT变量。

我稍微修改了它，以便可以在运行命令之前输入所需的SNAPUNIT。感谢用户bruno。valsecchi在另一个论坛上。

其工作原理如下：

copy

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

copy

(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)
) 
)

[编程交流] Quantise LISP工作正常，但m

发表回复

精选推荐