TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: 2e4lite on February 22, 2014, 05:20:33 AM

Title: About swap position of entities
Post by: 2e4lite on February 22, 2014, 05:20:33 AM
Who can help me to improve the following routine:
It's required that the routine provides three methods to specify base point:
 1.According to the middle point that is selected entities by user as the base point to swap position of entities(the default).
 2.With the insertion point of block or text as the base point to swap position of entities.
 3.According to the point is specified by user as the base point to swap position of entities.
thanks!

Code - Auto/Visual Lisp: [Select]
  1. (defun C:sw()
  2.       (princ "\nTo choose the first one: ")
  3.       (setq sa (ssget))
  4.    (setq pa (getpoint "\n Specify base point:  "))
  5.       (princ "\nSelect the second: ")
  6.       (setq sb (ssget))
  7.    (setq pb (getpoint "\n Specify base point:  "))
  8.    (command "move" sa "" pa pb)
  9.    (command "move" sb "" pb pa)
  10.    )
Title: Re: About swap position of graphics
Post by: irneb on February 22, 2014, 05:36:05 AM
Sorry, I had difficulty understanding your description. Though it seems you want a swap-move command ... something like this: http://www.cadtutor.net/forum/showthread.php?47900-quot-Swap-quot-lisp-doesn-t-work-in-Acad-2010
Title: Re: About swap position of graphics
Post by: 2e4lite on February 22, 2014, 06:00:11 AM
It does a swap-move command .Just want to add some methods of specifying base point .
Title: Re: About swap position of entities
Post by: 2e4lite on March 09, 2014, 06:14:04 AM

   When Select first object and second object in following routine , It 's use entsel function,Who can modify the routine by using ssget  function instead of entsel function.thanks!

Code - Auto/Visual Lisp: [Select]
  1. (defun c:EW  (/ *error* lst f)
  2.   ;; Entity Swap
  3.   ;; Entity Swap ;; Alan J. Thompson, 06.05.08 / 07.10.08 / 05.01.10
  4.   (defun *error*  (msg)
  5.     (and f *AcadDoc* (vla-EndUndoMark *AcadDoc*))
  6.     (and msg
  7.     (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*"))
  8.     (princ (strcat "\nError: " msg))))
  9.   (if (and (car   (setq lst
  10.              (cons (car (entsel "\nSelect first object: ")) lst)))
  11.       (cadr (vl-remove nil
  12.              (setq lst
  13.                (cons (car (entsel "\nSelect second object: "))
  14.                 lst)))))
  15.     ((lambda (pts)
  16.        (setq f
  17.          (not (vla-StartUndoMark
  18.            (cond (*AcadDoc*)
  19.             ((setq *AcadDoc* (vla-get-activedocument
  20.                      (vlax-get-acad-object))))))))
  21.        (mapcar (function (lambda (o a b)
  22.             (vl-catch-all-apply
  23.               (function vla-move)
  24.               (list o a b))))
  25.           (mapcar (function vlax-ename->vla-object) lst)
  26.           pts
  27.           (reverse pts)))
  28.       (mapcar
  29.    (function
  30.      (lambda (x) (vlax-3d-point (cdr (assoc 10 (entget x))))))
  31.    lst)))
  32.   (*error* nil)
  33.   (princ))
Title: Re: About swap position of entities
Post by: CAB on March 09, 2014, 10:44:40 AM
Where did you get the code?
This should work.
Code - Auto/Visual Lisp: [Select]
  1. (defun c:EW  (/ *error* lst f)
  2.  ;; Entity Swap
  3.   ;; Entity Swap ;; Alan J. Thompson, 06.05.08 / 07.10.08 / 05.01.10
  4.   ;; 03.09.14 Modified by CAB
  5.  
  6.  (defun *error*  (msg)
  7.    (and f *AcadDoc* (vla-EndUndoMark *AcadDoc*))
  8.    (and msg
  9. (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*"))
  10. (princ (strcat "\nError: " msg))))
  11. (princ "\nSelect two entities to swap: ")
  12. (if (and (setq ss (ssget))
  13.          (or (= (sslength ss) 2) (print "Must be two objects only"))
  14.          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
  15.    ((lambda (pts)
  16.       (setq f
  18.     (cond (*AcadDoc*)
  20.      (vlax-get-acad-object))))))))
  21.       (mapcar (function (lambda (o a b)
  22.   (vl-catch-all-apply
  24.     (list o a b))))
  25.       (mapcar (function vlax-ename->vla-object) lst)
  26.       pts
  27.       (reverse pts)))
  28.      (mapcar
  30.  (lambda (x) (vlax-3d-point (cdr (assoc 10 (entget x))))))
  31. lst)))
  32.  (*error* nil)
  33.  (princ))
Title: Re: About swap position of entities
Post by: snownut2 on March 09, 2014, 11:55:06 AM
Appears he got it from the link supplied by irneb, from Alanjt's post, (I assume that's the root of your question)
 however he removed the header indicating the author....   :realmad:

Apparently reading many previous post regarding this subject (removing authors information) is beyond his comprehension level.
Title: Re: About swap position of entities
Post by: CAB on March 10, 2014, 01:20:11 PM
Thanks for point that out.
I added the headers back in both lisp.