Mirror LISP help

[Cad-n-ator]

I am looking for a lisp routine that can mirror and object by selecting a line as the axis and not having to select the 1st and 2nd points and keep the original object in its place.

Any help would be very much appreciated!

 

Thanks!

JQJ

[mdbdesign]

Try this:

http://www.nyacad.com/QuickMirror/QuickMirror.html

[Lee Mac]

This should work with pretty much all objects

 

(defun c:MObj (/ *error* i ss ent pt uFlag)
 ;; Lee Mac  ~  12.01.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (cond (doc) ((vla-get-ActiveDocument
                          (vlax-get-Acad-Object)))))        

 (if (setq j -1 ss (ssget "_:L"))
   (while
     (progn
       (setq ent (entsel "\nSelect Mirror Line: "))

       (cond (  (vl-consp ent)

                (if (not
                      (vl-catch-all-error-p
                        (setq pt
                          (vl-catch-all-apply
                            (function vlax-curve-getClosestPointto)
                              (list (car ent) (cadr ent))))))
                  
                  (progn
                    (setq uFlag (not (vla-StartUndoMark doc)))
                    
                    (setq i (fix (vlax-curve-getParamatPoint (car ent) pt)))
                    (mapcar (function set) '(p1 p2)
                            (mapcar (function vlax-3D-point)
                                    (mapcar (function vlax-curve-getPointatParam)
                                            (list (car ent) (car ent)) (list i (1+ i)))))

                    (while (setq ent (ssname ss (setq j (1+ j))))
                      (vla-mirror (vlax-ename->vla-object ent) p1 p2))

                    (setq uFlag (vla-EndUndoMark doc)))

                  (princ "\n** Invalid Object Selected **")))

             (t (princ "\n** Nothing Selected **"))))))
 (princ))

[Lee Mac]

Actually, this is probably better:

 

(defun c:MObj (/ *error* DER ENT J P1 P2 PT SS UFLAG)
 ;; Lee Mac  ~  12.01.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (cond (doc) ((vla-get-ActiveDocument
                          (vlax-get-Acad-Object)))))        

 (if (setq j -1 ss (ssget "_:L"))
   (while
     (progn
       (setq ent (entsel "\nSelect Mirror Line: "))

       (cond (  (vl-consp ent)

                (if (not
                      (vl-catch-all-error-p
                        (setq pt
                          (vl-catch-all-apply
                            (function vlax-curve-getClosestPointto)
                              (list (car ent) (cadr ent))))))
                  
                  (progn
                    (setq uFlag (not (vla-StartUndoMark doc)))
                    
                    (setq Der (angle '(0 0 0)
                                (vlax-curve-getFirstDeriv (car ent)
                                  (vlax-curve-getParamatPoint (car ent) pt))))
                    
                    (mapcar (function set) '(p1 p2)
                            (mapcar (function vlax-3D-point) (list pt (polar pt Der 1.))))

                    (while (setq ent (ssname ss (setq j (1+ j))))
                      (vla-mirror (vlax-ename->vla-object ent) p1 p2))

                    (setq uFlag (vla-EndUndoMark doc)))

                  (princ "\n** Invalid Object Selected **")))

             (t (princ "\n** Nothing Selected **"))))))
 (princ))

Example:

 

[Cad-n-ator]

Thanks Lee Mac!

Works likes a charm!

[Lee Mac]

Thanks Lee Mac!

Works likes a charm!

 

You're welcome

[kramerO]

Lee Mac,

I've been using this routine all day long creating a couple hundred blocks. It saved me a lot of time.

Thanks much.

 

Cad-n-ator,

Thank you for starting the thread that got this great tool.

 

kramerO

[Lee Mac]

Thanks for the positive feedback

 

I have decided to update the code on my site here with added features

 

Enjoy!

 

Lee

[kramerO]

Thanks for the positive feedback

 

I have decided to update the code on my site here with added features

 

Enjoy!

 

Lee

 

Lee Mac,

Now I have to revise the toolbar I made for this routine (AutoCAD 2005) to have a button for each of the 4 different commands.

 

Thanks,

kramerO

[Lee Mac]

 

........

[Arepo]

Very elegant approach and very useful programs, Mr. Lee. Many thanks. You are a wizard!

[Lee Mac]

Very elegant approach and very useful programs, Mr. Lee. Many thanks. You are a wizard!

 

Thanks Arepo! Enjoy

[saunambon654]

On 1/13/2010 at 12:37 AM, Lee Mac said:

Actually, this is probably better:

 

 

(defun c:MObj (/ *error* DER ENT J P1 P2 PT SS UFLAG)
 ;; Lee Mac  ~  12.01.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (cond (doc) ((vla-get-ActiveDocument
                          (vlax-get-Acad-Object)))))        

 (if (setq j -1 ss (ssget "_:L"))
   (while
     (progn
       (setq ent (entsel "\nSelect Mirror Line: "))

       (cond (  (vl-consp ent)

                (if (not
                      (vl-catch-all-error-p
                        (setq pt
                          (vl-catch-all-apply
                            (function vlax-curve-getClosestPointto)
                              (list (car ent) (cadr ent))))))
                  
                  (progn
                    (setq uFlag (not (vla-StartUndoMark doc)))
                    
                    (setq Der (angle '(0 0 0)
                                (vlax-curve-getFirstDeriv (car ent)
                                  (vlax-curve-getParamatPoint (car ent) pt))))
                    
                    (mapcar (function set) '(p1 p2)
                            (mapcar (function vlax-3D-point) (list pt (polar pt Der 1.))))

                    (while (setq ent (ssname ss (setq j (1+ j))))
                      (vla-mirror (vlax-ename->vla-object ent) p1 p2))

                    (setq uFlag (vla-EndUndoMark doc)))

                  (princ "\n** Invalid Object Selected **")))

             (t (princ "\n** Nothing Selected **"))))))
 (princ))

 

Example:

 

 

There something is not correct for me, could you help to solve?

[Nguyễn Nam Nguyên]

Can you help me edit this lisp?
Mirror selected objects as polyline, know the symmetry axis as the longest edge of the object, and delete the original object after executing the command.

(defun c:mirror-polyline ()
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  (setq max_length 0)
  (setq max_edge nil)
  (if (setq obj (ssname ss 0))
    (progn
      (setq vertex_count (vlax-get-property (vlax-ename->vla-object obj) 'NumberOfVertices))
      (setq vertices (vlax-get-property (vlax-ename->vla-object obj) 'VertexCoordinates))
      (setq prev_point (car vertices))
      (setq max_edge_start prev_point)
      (setq max_edge_end (car (last vertices)))
      (setq max_length (distance max_edge_start max_edge_end))
      (setq cur_vertex 1)
      (while (< cur_vertex vertex_count)
        (setq cur_point (nth cur_vertex vertices))
        (setq cur_length (distance prev_point cur_point))
        (if (> cur_length max_length)
          (progn
            (setq max_length cur_length)
            (setq max_edge_start prev_point)
            (setq max_edge_end cur_point)
          )
        )
        (setq prev_point cur_point)
        (setq cur_vertex (1+ cur_vertex))
      )
      (setq mirror_axis (vlax-3d-point (mapcar '/ (mapcar '+ max_edge_start max_edge_end) '(2.0 2.0 2.0))))
      (command "_.MIRROR" obj "" mirror_axis "")
      (command "_.ERASE" obj "")
    )
  )
  (princ)
)

 

Edited March 2, 2023 by SLW210
Add Code Tags!!