[编程交流] Flter非均匀缩放blo

(defun newss  (/ ss i ename)
 (if (setq ss (ssget (list '(0 . "INSERT"))))
   (repeat (setq i (sslength ss))
     (setq ename (ssname ss (setq i (1- i))))
     (if (not (= (cdr (assoc 41 (entget ename)))
                 (cdr (assoc 42 (entget ename)))
                 (cdr (assoc 43 (entget ename))))
              )
       (ssdel ename ss)
       )
     )
   (alert "\nNothing select. Try again.")
   )
 ss
 )

[b][color=BLACK]([/color][/b]defun c:noteq [b][color=FUCHSIA]([/color][/b]/ ss i en ed[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq neq [b][color=NAVY]([/color][/b]ssadd[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]setq i 0[b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss i[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]= [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 41 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                         [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 42 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                         [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 43 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]ssadd en neq[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq i [b][color=GREEN]([/color][/b]1+ i[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]alert [b][color=NAVY]([/color][/b]strcat [color=#2f4f4f]"UnEqual Scaked Blocks Found = "[/color] [b][color=MAROON]([/color][/b]rtos [b][color=GREEN]([/color][/b]sslength neq[b][color=GREEN])[/color][/b] 2 0[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(defun c:selnublocks ( / i s x )
   (if (setq s (ssget "_X" (list '(0 . "INSERT") (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model")))))
       (repeat (setq i (sslength s))
           (setq x (entget (ssname s (setq i (1- i)))))
           (if (and (equal (abs (cdr (assoc 41 x))) (abs (cdr (assoc 42 x))) 1e-
                    (equal (abs (cdr (assoc 41 x))) (abs (cdr (assoc 43 x))) 1e-
               )
               (ssdel (cdr (assoc -1 x)) s)
           )
       )
   )
   (sssetfirst nil s)
   (princ)
)

(if 
                        (not
                                (and (equal (abs (cdr (assoc 41 x))) (abs (cdr (assoc 42 x))) 1e-
                                        (equal (abs (cdr (assoc 41 x))) (abs (cdr (assoc 43 x))) 1e-
                                )
                        )
                        (ssdel (cdr (assoc -1 x)) s)
                )