Jump to content

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


K Baden

Recommended Posts

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!

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

(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 by ronjonp
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

  • Like 1
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 6 years later...

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)

  • Like 1
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...