LISP for moviing drawing to 0,0 using a predefined basepoint.

[K Baden]

if there's a way to remove user intervention, that would be ideal. the object that will be the center point needing moved is always the only triangle or circle on the same layer "TOWER".

is there a way to have it grab the center of a circle and/or the geometric center of a triangle on that specific layer automatically, then select all objects from all layers, then move to 0,0 using that center point as a base point, all at the key in of a command?

 

 

You guys have been great helping me out with a few things. Thanks in advance for any advice!

[Commandobill]

If that is the only object on that layer it should be pretty simple. Can you write in LISP at all or are you looking for someone to write it?

 

I would start by using lee mac's poly centroid to get the center of the tower. Then just use ssget to select all items and vla-move.

 

Should be really simple.

[ronjonp]

(defun c:moveto0 (/ p s s2)
 (if (and (setq s (ssget "_X"
		  '((-4 . "<OR")
		    (0 . "circle")
		    (-4 . "<AND")
		    (0 . "lwpolyline")
		    (90 . 3)
		    (-4 . "AND>")
		    (-4 . "OR>")
		    (8 . "tower")
		   )
	   )
   )
   (setq s2 (ssget "_X" (list (cons 410 (getvar 'ctab)))))
     )
   (progn
     (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
  (progn (setq p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget e))))
	 (setq p
		(append (mapcar '(lambda (x) (/ x (length p))) (apply 'mapcar (cons '+ p))) '(0.0))
	 )
  )
  (setq p (cdr (assoc 10 (entget e))))
)
;; Does not check if the object is on a locked layer...
(vlax-invoke (vlax-ename->vla-object e) 'move p '(0. 0. 0.))
(ssdel e s2)
     )
     (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s2)))
;; Does not check if the object is on a locked layer...
(vlax-invoke (vlax-ename->vla-object e) 'move p '(0. 0. 0.))
     )
   )
 )
 (princ)
)
(vl-load-com)

Edited August 15, 2017 by ronjonp

[K Baden]

This works beautifully for moving the tower!! Is there anyway to have it do a select all on the drawing before moving? Right now, this moves just that object, which is lovely, but i definitely need the whole drawing to move along with it.

 

Thanks you so much!!!

[Lee Mac]

Ron was too quick for me, but I'll post mine anyway:

(defun c:twrm ( / ent len lst sel )
   (if (setq sel
           (ssget "_X"
              '(
                   (008 . "TOWER")
                   (410 . "Model")
                   (-04 . "<OR")
                       (000 . "CIRCLE")
                       (-04 . "<AND")
                           (000 . "LWPOLYLINE")
                           (090 . 3)
                           (-04 . "&=")
                           (070 . 1)
                       (-04 . "AND>")
                   (-04 . "OR>")
               )
           )
       )
       (progn
           (setq ent (ssname sel 0)
                 lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget ent)))
                 len (length lst)
           )
           (command "_.move"
               (ssget "_X" '((410 . "Model"))) ""
               "_non"  (trans (mapcar '/ (apply 'mapcar (cons '+ lst)) (list len len)) ent 1)
               "_non" '(0.0 0.0)
           )
       )  
       (princ "\nTower object not found.")
   )
   (princ)
)

[ronjonp]

Code updated.

[K Baden]

This works perfectly. Thank you both so much!!!

[K Baden]

(defun c:twrm ( / ent len lst sel )
   (if (setq sel
           (ssget "_X"
              '(
                   (008 . "TOWER")
                   (410 . "Model")
                   (-04 . "<OR")
                       (000 . "CIRCLE")
                       (-04 . "<AND")
                           (000 . "LWPOLYLINE")
                           [color="red"](090 . 3)[/color]
                           (-04 . "&=")
                           (070 . 1)
                       (-04 . "AND>")
                   (-04 . "OR>")
               )
           )
       )
       (progn
           (setq ent (ssname sel 0)
                 lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget ent)))
                 len (length lst)
           )
           (command "_.move"
               (ssget "_X" '((410 . "Model"))) ""
               "_non"  (trans (mapcar '/ (apply 'mapcar (cons '+ lst)) (list len len)) ent 1)
               "_non" '(0.0 0.0)
           )
       )  
       (princ "\nTower object not found.")
   )
   (princ)
)

 

Would adding the rare but occasional square towers we get just be adding another line? im guessing that the line highlighted looks for ploylines with 3 points? would it be as simple as repeating this and making it 4?

[ronjonp]

If your layering is solid, you could probably take out the number of vertices check.

 

You could also do something like this to check for lwpolylines with less than 5 vertices:

(ssget "_X"
	 '((008 . "*")
	   (410 . "Model")
	   (-04 . "<OR")
	   (000 . "CIRCLE")
	   (-04 . "<AND")
	   (000 . "LWPOLYLINE")
	   (-04 . "<")
	   (090 . 5)
	   (-04 . "&=")
	   (070 . 1)
	   (-04 . "AND>")
	   (-04 . "OR>")
	  )
  )

[K Baden]

Good call! didn't even think of that. This works great for all sorts of scenarios ive tested. Thanks guys!!

[K Baden]

so, one last thing (SORRY!!!!) is there a way to get it to just end the command gracefully if there are either no objects found, OR more than 2? we use an offset and hatch for the tower as you can see in my above drawing, so there will always be either 2 circles or 2 polylines on the layer. very occasionally we have more than one tower on a site. the layering SHOULD be correct, but sometimes it isn't.

 

Is that just way too much to ask it to do?

[Lee Mac]

Perhaps something like this?

(defun c:twrm ( / ent len lst sel )
   (cond
       (   (null
               (setq sel
                   (ssget "_X"
                      '(
                           (008 . "TOWER")
                           (410 . "Model")
                           (-04 . "<OR")
                               (000 . "CIRCLE")
                               (-04 . "<AND")
                                   (000 . "LWPOLYLINE")
                                   (-04 . "<")
                                   (090 . 5)
                                   (-04 . "&=")
                                   (070 . 1)
                               (-04 . "AND>")
                           (-04 . "OR>")
                       )
                   )
               )
           )
           (princ "\nNo Tower objects found.")
       )
       (   (< 2 (sslength sel))
           (princ "\nMore than two Tower objects found.")
       )
       (   (setq ent (ssname sel 0)
                 lst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget ent)))
                 len (length lst)
           )
           (command "_.move"
               (ssget "_X" '((410 . "Model"))) ""
               "_non"  (trans (mapcar '/ (apply 'mapcar (cons '+ lst)) (list len len)) ent 1)
               "_non" '(0.0 0.0)
           )
       )
   )
   (princ)
)

[K Baden]

This is amazing. Thanks!! You're both incredible with this stuff. I appreciate it !!!

[Wan]

How to do these for batch processing? Please help me.

[Steven P]

Which batch processing routine are you trying them with? There is no user interaction needed and so should work OK

 

(you'll need something like Lee Macs Scriptwriter to run the batch - on his website)