Jump to content

Flter non-uniformly scaled block

DuanJinHui

By DuanJinHui
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

DuanJinHui Collaborator

DuanJinHui

Posted
Posted

Use ""ssget" ,I want filter non-uniformly scaled block. 

(setq ss (ssget (list '(0 . "INSERT"))))

 

Any good idea? Thanks.

Tharwat Grand Master

Tharwat

Posted
Posted

Hi,

 

You may need to change the value of 1.0 to your desired one. :)

(setq ss (ssget '((-4 . "<NOT")
                 (-4 . "<AND")
                 (0 . "INSERT")
                 (41 . 1.0)
                 (42 . 1.0)
                 (43 . 1.0)
                 (-4 . "AND>")
                 (-4 . "NOT>")
                 )
               )
     )

DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted
Hi,

 

You may need to change the value of 1.0 to your desired one. :)

(setq ss (ssget '((-4 . "<NOT")
                 (-4 . "<AND")
                 (0 . "INSERT")
                 (41 . 1.0)
                 (42 . 1.0)
                 (43 . 1.0)
                 (-4 . "AND>")
                 (-4 . "NOT>")
                 )
               )
     )

 

Thanks Tharwat.

But this is not I need. :(

I need choose uniformly scaled blocks .

eg. (41 . 1.0)(42 . 1.0)(43 . 1.0)

(41 . 2.0)(42 . 2.0)(43 . 2.0)

(41 . 3.0)(42 . 3.0)(43 .3.0).... etc.

DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted

I know use "entsel" function can do this:

(setq blkref (car (entsel "\n>>>Choose a block:")))

 

(if (not(= (cdr(assoc 41 (entget blkref))) (cdr(assoc 42 (entget blkref))) (cdr(assoc 43 (entget blkref)))))
				(progn
					(alert "\nNOT support　non-uniformly scaled block.")
					t
				)
				(progn

Tharwat Grand Master

Tharwat

Posted
Posted

I am really not sure that you can filter many blocks with different scale values of X,Y and Z but you can have only one as I've demonstrated in the first reply.

 

Otherwise you can make a selection set of blocks then cycle through each block object and add objects to a list when their scales X,Y,Z are matched.

DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted
I am really not sure that you can filter many blocks with different scale values of X,Y and Z but you can have only one as I've demonstrated in the first reply.

 

Otherwise you can make a selection set of blocks then cycle through each block object and add objects to a list when their scales X,Y,Z are matched.

 

Maybe need write a sub-function.:lol:

Tharwat Grand Master

Tharwat

Posted
Posted
Maybe need write a sub-function.:lol:

 

Try it and let me know if you need any help. ;)

DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted
Try it and let me know if you need any help. ;)

 

:lol: Maybe need 1 day or more . I will try .

Tharwat Grand Master

Tharwat

Posted
Posted
:lol: Maybe need 1 day or more . I will try .

 

Nooo, it is simple.

 

If you don't try and give at least 75% of codes correct, I won't reply to any of your threads anymore. :D

DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted (edited)
Nooo, it is simple.

 

If you don't try and give at least 75% of codes correct, I won't reply to any of your threads anymore. :D

 

This ? Any suggestions ? Thanks.

 

(defun newss(/ ss i ename )
(while 
	(if (null(setq ss (ssget (list '(0 . "INSERT")))))
		(progn
			(alert "\nNothing select. Try again.")
			t
		)
		(progn
			(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))))
					)
					(setq ename(ssdel ename ss))
				)
			)
			nil
		)
	)
)
ename
)

 

So,if need use this new selection set.

; test
(setq en (newss))
(command "_.move" en "")

Edited by DuanJinHui
Add testing code.
Tharwat Grand Master

Tharwat

Posted
Posted

So far so good ;)

 

You don't need the while function and the return of the function must be the variable ss and not the entity name and a few little mods.

Keep on coding and no matter how many mistakes you would have.

 

Take a look.

 

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

David Bethel Grand Master

David Bethel

Posted
Posted (edited)

Maybe :

 

[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]

 

 

global neq PICKSET

 

-David

Edited by David Bethel
BIGAL Grand Master

BIGAL

Posted
Posted

Using VL easy to just compare X & Y & Z etc dont need to remember the assoc code

 

; XEffectiveScaleFactor = 1.0

; XScaleFactor = 1.0

; YEffectiveScaleFactor = 2.0

; YScaleFactor = 2.0

; ZEffectiveScaleFactor = 1.0

; ZScaleFactor = 1.0

DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted

Thanks Tharwat and David .

 

Hi David. My drawing have non-uniformly scaled block. I use your code for testing. But alert　"UnEqual Scaled Blocks Found=0"

David Bethel Grand Master

David Bethel

Posted
Posted
Hi David. My drawing have non-uniformly scaled block. I use your code for testing. But alert　"UnEqual Scaled Blocks Found=0"

 

My bad, I forgot /= has a quirk in that (/=1 2 2) returns nil.

 

I fixed the code in post #12

 

-David

Lee Mac Grand Master

Lee Mac

Posted
Posted

Do you want to select non-uniformly scaled blocks but ignore mirrored blocks (i.e. for which the x-scale factor is negative)?

 

Since the block scale is stored as a double, I would recommend using the equal function with some tolerance when performing the comparison, i.e.:

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

DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted
Do you want to select non-uniformly scaled blocks but ignore mirrored blocks (i.e. for which the x-scale factor is negative)?

 

Since the block scale is stored as a double, I would recommend using the equal function with some tolerance when performing the comparison, i.e.:

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

 

I ignore mirrored blocks. Many Thanks Lee. If I want select uniformly scaled blocks, Just replace "equal" to "/=" , Right ?

 

Mention mirrored blocks ,I reminded a question.

http://www.cadtutor.net/forum/showthread.php?96562-Lee-s-MirrorBlock.lsp-have-a-bug

Lee Mac Grand Master

Lee Mac

Posted
Posted
I ignore mirrored blocks. Many Thanks Lee. If I want select uniformly scaled blocks, Just replace "equal" to "/=" , Right ?

 

I would suggest enclosing the (and) expression with a (not) to reverse the condition.

DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted
I would suggest enclosing the (and) expression with a (not) to reverse the condition.

 

Lee,Thank you again.

 

Like this?

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

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