Jump to content

Set Z Position of all Blocks to Zero


harilalmn
 Share

Recommended Posts

What is wrong in the code? I am trying to set the Z position value to zero for all the blocks in the drawing;

 

(defun c:B0()
 (setq myFilter(list (cons 0 "INSERT")))
 (setq ss (ssget "_X" myFilter))
 (setq l (sslength ss))
 (setq i 0)
 (Repeat l
   (setq blk (ssname ss i))
   (setq DXF (entget (car blk)))
   (setq IP (cadr (assoc 0 dxf)))
   (setq NewIP (subst "0" (caddr  IP) IP))
   (setq NewDXF (subst NewIP IP DXF))
   (entmod NewDXF)
 )
)

Link to comment
Share on other sites

  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • Tharwat

    7

  • harilalmn

    6

  • pBe

    5

  • Lee Mac

    3

Top Posters In This Topic

[color=black](defun c:B0  ()[/color]
[color=black]    (setq myFilter (list (cons 0 "INSERT")))[/color]
[color=black]    (setq ss (ssget "_X" myFilter))[/color]
[color=black]    (setq l (sslength ss))[/color]
[color=black]    (setq i 0)[/color]
[color=black]    (Repeat l[/color]
[color=black]          (setq blk (ssname ss i))[/color]
[color=black]          (setq DXF (entget blk))[/color]
[color=black]          (setq IP ([color=sienna]cdr [/color](assoc [color=sienna]10 [/color]dxf)))[/color]
[color=black]          (setq NewIP (subst [color=sienna]0.00[/color] (caddr IP) IP))[/color]
[color=black]          (setq NewDXF (subst [color=sienna](cons 10 NewIP) (assoc 10 dxf)[/color] DXF))[/color]
[color=black]          (entmod NewDXF)[/color]
[color=sienna](setq i (1+ i))[/color]
[color=black]          )[/color]
[color=black]    )[/color]

 

variable i remains at 0.... "0" as string not real number...

Among other things....

Edited by pBe
Link to comment
Share on other sites

Try this ...

(defun c:Test (/ ss i sset lst)
 (vl-load-com)
 (if (setq ss (ssget "_x" '((0 . "INSERT") (410 . "model"))))
   (repeat (setq i (sslength ss))
     (setq sset (ssname ss (setq i (1- i))))
     (setq lst (cons (vlax-ename->vla-object sset) lst))
   )
   (alert " << No Blocks existed in this drawing >>  ")
 )
 (foreach ml '(1e99 -1e99)
   (mapcar (function (lambda (x)
                       (vla-move x
                                 (vlax-3d-point (list 0 0 0))
                                 (vlax-3d-point (list 0 0 ml))
                       )
                     )
           )
           lst
   )
 )
 (princ)
)

Tharwat

Link to comment
Share on other sites

pBe Thanks for your comment.. I now understand I should have added a (setq i (1+ i)) in the repeat loop...!!

 

Thanks for the code Tharwat...!! That was much professional a solution compared to my code...!!

 

Happy Happy.... :D

Link to comment
Share on other sites

I would approach it this way:

 

(defun c:B0 ( / e i p s )
   (if (setq s (ssget "_X" '((0 . "INSERT") (-4 . "*,*,<>") (10 0.0 0.0 0.0))))
       (repeat (setq i (sslength s))
           (setq e (entget (ssname s (setq i (1- i))))
                 p (assoc 10 e)
           )
           (entmod (subst (list 10 (cadr p) (caddr p) 0.0) p e))
       )
   )
   (princ)
)

 

I don't see the need to move everything to 1e99 elevation and back just to set the elevation to zero :?

Link to comment
Share on other sites

Using (subst) on a point value is very dangerous

 

(setq ip '(10 10 10 10))

(subst 0 (caddr ip) ip)

 

Returns -> '(0 0 0 0)

 

 

[b][color=BLACK]([/color][/b]defun c:iz0 [b][color=FUCHSIA]([/color][/b]/ ss en ed in[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][b][color=BLUE]([/color][/b]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]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[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]
                   in [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 10 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entmod [b][color=GREEN]([/color][/b]subst [b][color=BLUE]([/color][/b]list 10 [b][color=RED]([/color][/b]car in[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cadr in[b][color=RED])[/color][/b] 0.0[b][color=BLUE])[/color][/b]
                            [b][color=BLUE]([/color][/b]assoc 10 ed[b][color=BLUE])[/color][/b] ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entupd en[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss[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]

 

I would think a lot more filtering would be advisable. Maybe groups 67 210 at the very least should be added.

 

Also this will not move the attributes the elevation 0.

 

-David

Link to comment
Share on other sites

....
(1e99 -1e99)..... 

 

Interesting :)

 

Thanks pBe . :beer:

 

 

I don't see the need to move everything to 1e99 elevation and back just to set the elevation to zero :?

 

Why not ?

 

Would that harm or incorrect in away or another ? :)

 

Tharwat

Link to comment
Share on other sites

 

Thanks for the code Tharwat...!! That was much professional a solution compared to my code...!!

 

Happy Happy.... :D

 

You're welcome harilalmn .

 

Enjoy it buddy :beer:

 

Tharwat

Link to comment
Share on other sites

Why not ?

 

:facepalm: Because there is no need to do so - you can just move the objects directly to zero elevation. Moving objects to 1e99 elevation and back is merely expoiting the inherent limit of the AutoCAD coordinate system, and expecting the difference greater than 1e99 to be discarded. This method is usually used in 'Flatten' routines where there may be no alternative.

Link to comment
Share on other sites

Lee,

I dont know what is happening.... Could you please look at the attached drawing? It is a part of the original file 'WBlock'-ed. I want to make everything coplanar in this.

 

I have a script file as below;

 

move
all

0,0,0
0,0,1e99
move
p

0,0,0
0,0,-1e99

 

For some reason, the script is killing the file...!!

It moves the lines and blocks on xy plane too...!! :reallymad:

 

It was to fix this file that I tried the lisp above...

Could you please tell me what is wrong?

Test_Drawing.dwg

Link to comment
Share on other sites

But I thought the above script file would bring everything to zero level...!!?? Is it not?

 

If you want it for all entities just remove the (0 . "insert") from my code and try again . :)

Link to comment
Share on other sites

Tharwat... Still that doesn't seem to be working... It takes some of the arcs, off their correct locations... However, blocks are not getting disoriented...!

Link to comment
Share on other sites

One does wonder that when a drawing is posted, whether it is actually used to test the code posted :?

 

I had a look at the drawing, and the geometry is something that I have never seen before. It is slightly wonky, and the arcs are not quite parallel to the main axes. It seems to be an excellent test for any flattening lisp, which at the moment does not seem to be able to cope with it.

 

How should the geometry be altered so that the flatten lisp will work?

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


×
×
  • Create New...