Jump to content

Z Coordinate, moving all objects to 0 with space defined.


CafeJr

Recommended Posts

Hello to all,

 

I'm back needing a help again, I have one "challenge" (problem! He he he...) that consist in get every object that has on a specific coordinate Z (plan), and I need to take every item of this plan moving it to Z=0, but, I have 200 plans with 6 objects each one, moving it to Z=0 it will be one above other, It's necessary move it in coordinate X with a specific space (one item to be filled up).

 

Z to 0.jpg

 

I'll be grateful if someone knows a Lisp that could help!...

 

Thanks in advance!

Link to comment
Share on other sites

I found something that could help me, but someone knows how I can get all objects at same plane to move it together? It's that missing to finish the code!

 

Thanks in advance!!!...

Link to comment
Share on other sites

The code that I'd found... so doesn't work moving on X position... It's working good, but, entities are overlapping!... In red I make a simple way to move the objects... level by level... modifying the 5000 value... I can do it incremente it by level or by a input number to be filled up by the user.

 

If someone could help me... thanks in advance...

 

    ; ZeroZ.lsp
    ;
    ; Change Z coordinate of all selected entities to 0 (OCS)
    ;
    ; Copyright (c) 2000 Michael Puckett All Rights Reserved
    ;
    ; ==================================================?=====
(defun c:zeroz
       (/   ; local functions (defuns)
 *error* *begin* *end* *zeroz* *children* ; local vars
 ss i ent ents)
    ; local defun *error*
 (defun *error* (s)
   (*end*)
   (princ (strcat "Error: " s ".\n"))
   (princ)
 )
    ; local defun *begin*
 (defun *begin* ()
   (setvar "cmdecho" 0)
   (while (eq 8 (logand 8 (getvar "undoctl")))
     (command ".undo" "_end")
   )
   (if (zerop (logand 2 (getvar "undoctl")))
     (if (eq 1 (logand 1 (getvar "undoctl")))
(command ".undo" "_begin")
     )
   )
 )
    ; local defun *end*
 (defun *end* ()
   (if (eq 8 (logand 8 (getvar "undoctl")))
     (command ".undo" "_end")
   )
   (setvar "cmdecho" 1)
 )
    ; local defun *zeroz*
 (defun *zeroz* (ent)
   (entmod
     (mapcar
'(lambda (x)
   (cond
     ((member (car x) '(10 11 12 13 14))
      (cons (car x) (list (cadr x) (caddr x) 0.0))
     )
     ((eq 38 (car x)) '(38 . 0.0))
     (t x)
   )
 )
(entget ent)
     )
   )
 )
    ; local defun *children*
 (defun *children* (ent / d r)
   (if (assoc 66 (entget ent))
     (reverse
(while
  (/= "SEQEND"
      (cdr (assoc 0 (setq d (entget (setq ent (entnext ent))))))
  )
   (setq r (cons (cdr (assoc -1 d)) r))
)
     )
   )
 )
    ; main
 (cond
   ((setq i  -1
   ss (ssget)
    )

[color=red](command "_move" ss "" '(0.0 0.0 0.0) (cons 5000 '(0.0 0.0))) ; TEST[/color]     

    (*begin*)
    (princ "\nZeroing Z's for entity(s) ...")
    (repeat (sslength ss)
      (*zeroz* (setq ent (ssname ss (setq i (1+ i)))))
      (foreach x (setq ents (*children* ent)) (*zeroz* x))
      (if ents
 (entupd ent)
      )
    ; in case a bazillion entities were selected
    ; let the user know we have not died
      (if (zerop (rem i 100))
 (princ ".")
      )
    )
    (princ " [Done]")
    (*end*)
   )
   (t (princ "\nNothing selected."))
 )
    ; terminate
 (princ)
)

Link to comment
Share on other sites

CafeJr, please backup your DWG and try this and see if it suits your needs...

 

(defun c:elevs2xrefs ( / *error* fildia dwgn dwgname ss i ent entlst path loop bb se dx ch gap p )

 (defun *error* ( msg )
   (if fildia (setvar 'filedia fildia))
   (if msg (prompt msg))
   (princ)
 )

 (vl-load-com)
 (alert "\nAll enities in current MODEL space in DWG must be 2d and parallel to WCS - ENTER TO CONTINE else ESC to terminate")
 (setq fildia (getvar 'filedia))
 (setvar 'tilemode 1)
 (setq dwgn (getvar 'dwgname))
 (setq dwgname (substr dwgn 1 (- (strlen dwgn) 4)))
 (setq ss (ssget "_X" '((410 . "Model"))))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq entlst (cons ent entlst))
 )
 (if (not (vl-every '(lambda ( x ) (or (equal (assoc 210 x) '(210 0.0 0.0 1.0)) (equal (assoc 12 x) '(12 0.0 0.0 1.0)))) (mapcar 'entget entlst)))
   (progn
     (alert "\nNot all enities are parallel to WCS - quitting...")
     (exit)
   )
 )
 (if (not (vl-every '(lambda ( x ) (equal (caddr (car x)) (caddr (cadr x)) 1e-6)) (mapcar 'acet-ent-geomextents entlst)))
   (progn
     (alert "\nNot all enities are 2D - quitting...")
     (exit)
   )
 )
 (setvar 'filedia 0)
 (vla-save (vla-get-activedocument (vlax-get-acad-object)))
 (setq path (vl-catch-all-apply 'vl-filename-directory (list (getfiled "Select destination directory for dwg split export - pick one file in desired folder" "" "" 4))))
 (command "_.-layer" "on" "*" "t" "*" "u" "*" "")
 (command "_.ucs" "w")
 (command "_.ucs" "front")
 (command "_.plan" "")
 (command "_.zoom" "0.5xp")
 (setq loop t)
 (while loop
   (setq bb (acet-geom-ss-extents-accurate ss))
   (setq se (ssget "_F" (list (list (caar bb) (cadar bb)) (list (caadr bb) (cadar bb)))))
   (command "_.ucs" "w")
   (command "_.-wblock" (strcat path "\\" dwgname "-" (rtos (cadar bb)) ".dwg") "" (list 0.0 0.0 (cadar bb)) se "")
   (command "_.erase" se "")
   (command "_.-xref" "A" (strcat path "\\" dwgname "-" (rtos (cadar bb)) ".dwg") (list 0.0 0.0 (cadar bb)) "" "" "")
   (command "_.ucs" "p")
   (setq ss (acet-ss-remove se ss))
   (if (equal (cadar bb) (cadadr bb) 1e- (setq loop nil))
 )
 (command "_.saveas" "" (strcat path "\\" dwgname "-allelevs.dwg"))
 (command "_.ucs" "w")
 (command "_.plan" "")
 (command "_.zoom" "0.5xp")
 (setq ss (ssget "_X" '((410 . "Model"))))
 (setq bb (acet-geom-ss-extents-accurate ss))
 (setq dx (- (caadr bb) (caar bb)))
 (initget "Yes No")
 (setq ch (getkword "\nScatter created XREFS along X axis on elevation 0.0 [Yes/No] <Yes>: "))
 (if (or (eq ch "Yes") (eq ch nil))
   (progn
     (setq gap (abs (getdist "\nSpecify gap distance between 2 Xrefs along X axis: ")))
     (setq i -1)
     (while (setq ent (ssname ss (setq i (1+ i))))
       (vla-move (vlax-ename->vla-object ent) (vlax-3d-point (setq p (cdr (assoc 10 (entget ent))))) (vlax-3d-point (list (car p) (cadr p) 0.0)))
       (vla-move (vlax-ename->vla-object ent) (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (list (* (float i) (+ dx gap)) 0.0 0.0)))
     )
     (command "_.saveas" "" (strcat path "\\" dwgname "-allelevsscatter.dwg"))
   )
 )
 (*error* nil)
 (princ)
)

M.R.

Edited by marko_ribar
Link to comment
Share on other sites

CafeJr, please backup your DWG and try this and see if it suits your needs...

 

M.R.

 

:notworthy: Wowwww... You did the most hardly... separating the slices in new drawings... It's it Marko, are working!... Thank you again!... But, It's possible get the slices and put it on Z=0 on the same Model Space?... Spacing them by levels origin?... Objects on Z=10, goes to X=0 and Z=0, the next level Z=20 goes to X=5000 and Z=0, next level Z=30 goes to X=1000 and Z=0... until all levels are done?...

Link to comment
Share on other sites

I decided to space them using DX value of all sel. set of entities added with gap between them... Have you tried "Yes" option when asked for scatter?

 

BTW. I've changed code little more to check if entities are 2D - if not program quits and also quits if entities aren't parallel to WCS...

 

M.R.

Link to comment
Share on other sites

:notworthy: :thumbsup: Ok, thanks again Marko!... It's exactly that!... I saw that you use a external reference to put them side by side, I'm use it on the same Model Space to work with it, It's necessary to get the entity, explode, cut, and a lot of other things to do... On these way I need to use a Refedit, subtract from external reference (REFSET - remove from working set) all of them to can work, it's possible to do in another way? So, even this way, you save me a lot of time making this code and avoiding mistakes!!!... I'm realy greatful to you!!!...
Link to comment
Share on other sites

Once new file is generated with XREFs, you can simply do XREF command, select all XREFs and bind them... If you want to loose layer info that is to make it like in orig. DWG, when binding, use INSERT option and after that EXPLODE on created blocks... But if you want to keep layer prefixes obtained from XREFs, for ex. (dwgname-0.00000000$0$Layer1) you should use BIND option and then EXPLODE created blocks from XREFs... Of course 0 Layer will remain 0 in both cases, so it's strongly recommended to create new layers and put entities on them before (c:elevs2xrefs)...

 

M.R.

Link to comment
Share on other sites

Once new file is generated with XREFs, you can simply do XREF command, select all XREFs and bind them... If you want to loose layer info that is to make it like in orig. DWG, when binding, use INSERT option and after that EXPLODE on created blocks... But if you want to keep layer prefixes obtained from XREFs, for ex. (dwgname-0.00000000$0$Layer1) you should use BIND option and then EXPLODE created blocks from XREFs... Of course 0 Layer will remain 0 in both cases, so it's strongly recommended to create new layers and put entities on them before (c:elevs2xrefs)...

 

M.R.

 

Master Marko!... Thank you!!!... I was testing it, and works as good as I expect!!!... By the way, Its possible insert one text like "Z=position" on Xrefs tops? I got one doubt, inserting a space to Scatter (as example = 5000) it space the slices on 8633.2363 looking the code I didnt found why it's happening, I saw that has a "+ dx gap" could be "dx"?

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.

×
×
  • Create New...