Automatic Align

[omarsvn]

I worked in a simple code that let me align two polygons just choosing one of its lines, it worked but is not a 100% what I would like, I going to attach images as reference and the code I made.  I'd like to improve is the polygons should be aligned to the closest point of its vertices when I choose the line. They should not be aligned one inside the another, I don't know if it is possible to align the text included inside the polygon since most of the time the polygons contain text. finally I would like autoCAD requests me a distance as a kerf since sometimes a space is needed between polygons

(defun c:ALI ()

(setq picked_data (entsel "\nSelect object to align: ")

  picked_pline (car picked_data)

  picked_point (vlax-curve-getclosestpointto picked_pline (cadr picked_data))

  picked_param (fix (vlax-curve-getparamatpoint picked_pline picked_point)) 

  p1 (vlax-curve-getpointatparam picked_pline picked_param)

  p2 (vlax-curve-getpointatparam picked_pline (1+ picked_param))

)

  (setq picked_data2 (entsel "\nSelect the reference object: ")

  picked_pline2 (car picked_data2)

  picked_point2 (vlax-curve-getclosestpointto picked_pline2 (cadr picked_data2))

  picked_param2 (fix (vlax-curve-getparamatpoint picked_pline2 picked_point2)) 

  p3 (vlax-curve-getpointatparam picked_pline2 picked_param2)

  p4 (vlax-curve-getpointatparam picked_pline2 (1+ picked_param2))

)

  (command "align" pause "" p1 p3 p2 p4 "" "")

)

[omarsvn]

Marko, it works great, the problem is text and lines are inside the polygon don't move according to the polygon, I'm able to align the polygon but not the text and lines

[omarsvn]

It works great, now lines and text align according to polygons, thank you

[marko_ribar]

@omarsvn 

Do you know that you can make blocks or groups with polygons + texts/attributes, set variable "pickfirst" to 1 and apply my previously posted routine which is now slightly changed - see it on previous page...

[marko_ribar]

I noticed one lack which I fixed BTW... It aligned source piece with destination when *gap* was 0.0 with interferences... Now should work as desired... The code is on previous page - last one, not marked as a solution, but I think that it deserves at least kudo, or like...

[marko_ribar · Accepted solution]

Hi, OP...

I've cobbled something that you could use and I think that it's also solution...

Here is my latest code :

(defun c:aligned ( / *error* ftoa cmd pck pea es en p11 p12 p2 p3 p4 p5 p6 an pp ll ur ent ucsf ) ;;; *gap* - global variable ;;;

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun *error* ( m )
    (if ucsf
      (if command-s
        (command-s "_.ucs" "_p")
        (vl-cmdf "_.ucs" "_p")
      )
    )
    (if (= 8 (logand 8 (getvar (quote undoctl))))
      (if command-s
        (command-s "_.undo" "_e")
        (vl-cmdf "_.undo" "_e")
      )
    )
    (if pea
      (setvar (quote peditaccept) pea)
    )
    (if pck
      (setvar (quote pickfirst) pck)
    )
    (if cmd
      (setvar (quote cmdecho) cmd)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun ftoa ( n / m a s b )
    (if (numberp n)
      (progn
        (setq m (fix ((if (< n 0) - +) n 1e-8)))
        (setq a (abs (- n m)))
        (setq m (itoa m))
        (setq s "")
        (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
          (setq s (strcat s (itoa b)))
          (setq a (- (* a 10.0) b))
        )
        (if (= (type n) (quote int))
          m
          (if (= s "")
            m
            (if (and (= m "0") (< n 0))
              (strcat "-" m "." s)
              (strcat m "." s)
            )
          )
        )
      )
    )
  )

  (setq cmd (getvar (quote cmdecho)))
  (setvar (quote cmdecho) 0)
  (setq pck (getvar (quote pickfirst)))
  (setvar (quote pickfirst) 1)
  (setq pea (getvar (quote peditaccept)))
  (setvar (quote peditaccept) 1)
  (if (= 8 (logand 8 (getvar (quote undoctl))))
    (vl-cmdf "_.undo" "_e")
  )
  (vl-cmdf "_.undo" "_be")
  (if (= 0 (getvar (quote worlducs)))
    (progn
      (vl-cmdf "_.ucs" "_w")
      (setq ucsf t)
    )
  )
  (or *gap*
    (progn
      (initget 4)
      (setq *gap*
        (cond
          ( (getdist (strcat "\nPick or specify gap between pieces <" (ftoa (setq *gap* (if (not *gap*) 0.0 *gap*))) "> : ")) )
          ( t *gap* )
        )
      )
    )
  )
  (if
    (and
      (setq es (entsel "\nPick source polygonal polyline-block you want to align..."))
      (setq p3 (osnap (cadr es) "_nea"))
      (setq p11 (osnap (cadr es) "_end"))
      (progn
        (cond
          ( (= (cdr (assoc 0 (entget (car es)))) "INSERT")
            (vl-cmdf "_.-refedit" "_non" p3)
            (repeat 10
              (vl-cmdf "_n")
            )
            (vl-cmdf "_o" "_a" "_n")
            (cond
              ( (= (cdr (assoc 0 (entget (car (nentselp p3))))) "REGION")
                (vl-cmdf "_.explode" (car (nentselp p3)))
                (while (< 0 (getvar (quote cmdactive)))
                  (vl-cmdf "")
                )
                (setq p12 (if (< (distance p3 (vlax-curve-getstartpoint (car (nentselp p3)))) (distance p3 (vlax-curve-getendpoint (car (nentselp p3))))) (vlax-curve-getendpoint (car (nentselp p3))) (vlax-curve-getstartpoint (car (nentselp p3)))))
                (while
                  (and
                    (nentselp p3)
                    (/= (cdr (assoc 0 (entget (car (nentselp p3))))) "REGION")
                  )
                  (vl-cmdf "_.undo" 1)
                )
              )
              ( (= (cdr (assoc 0 (entget (car (nentselp p3))))) "LWPOLYLINE")
                (vl-cmdf "_.explode" (car (nentselp p3)))
                (while (< 0 (getvar (quote cmdactive)))
                  (vl-cmdf "")
                )
                (setq p12 (if (< (distance p3 (vlax-curve-getstartpoint (car (nentselp p3)))) (distance p3 (vlax-curve-getendpoint (car (nentselp p3))))) (vlax-curve-getendpoint (car (nentselp p3))) (vlax-curve-getstartpoint (car (nentselp p3)))))
                (while
                  (and
                    (nentselp p3)
                    (/= (cdr (assoc 0 (entget (car (nentselp p3))))) "LWPOLYLINE")
                  )
                  (vl-cmdf "_.undo" 1)
                )
              )
              ( (= (cdr (assoc 0 (entget (car (nentselp p3))))) "POLYLINE")
                (vl-cmdf "_.explode" (car (nentselp p3)))
                (while (< 0 (getvar (quote cmdactive)))
                  (vl-cmdf "")
                )
                (setq p12 (if (< (distance p3 (vlax-curve-getstartpoint (car (nentselp p3)))) (distance p3 (vlax-curve-getendpoint (car (nentselp p3))))) (vlax-curve-getendpoint (car (nentselp p3))) (vlax-curve-getstartpoint (car (nentselp p3)))))
                (while
                  (and
                    (nentselp p3)
                    (/= (cdr (assoc 0 (entget (car (nentselp p3))))) "POLYLINE")
                  )
                  (vl-cmdf "_.undo" 1)
                )
              )
              ( t
                (setq ent (cdr (assoc 0 (entget (car (nentselp p3))))))
                (setq p12 (if (< (distance p3 (vlax-curve-getstartpoint (car (nentselp p3)))) (distance p3 (vlax-curve-getendpoint (car (nentselp p3))))) (vlax-curve-getendpoint (car (nentselp p3))) (vlax-curve-getstartpoint (car (nentselp p3)))))
                (while
                  (and
                    (nentselp p3)
                    (/= (cdr (assoc 0 (entget (car (nentselp p3))))) ent)
                  )
                  (vl-cmdf "_.undo" 1)
                )
              )                
            )
            (vl-cmdf "_.refclose" "_d")
          )
          ( (= (cdr (assoc 0 (entget (car (nentselp p3))))) "REGION")
            (vl-cmdf "_.explode" (car (nentselp p3)))
            (while (< 0 (getvar (quote cmdactive)))
              (vl-cmdf "")
            )
            (setq p12 (if (< (distance p3 (vlax-curve-getstartpoint (car (nentselp p3)))) (distance p3 (vlax-curve-getendpoint (car (nentselp p3))))) (vlax-curve-getendpoint (car (nentselp p3))) (vlax-curve-getstartpoint (car (nentselp p3)))))
            (while
              (and
                (nentselp p3)
                (/= (cdr (assoc 0 (entget (car (nentselp p3))))) "REGION")
              )
              (vl-cmdf "_.undo" 1)
            )
          )
          ( (= (cdr (assoc 0 (entget (car (nentselp p3))))) "LWPOLYLINE")
            (vl-cmdf "_.explode" (car (nentselp p3)))
            (while (< 0 (getvar (quote cmdactive)))
              (vl-cmdf "")
            )
            (setq p12 (if (< (distance p3 (vlax-curve-getstartpoint (car (nentselp p3)))) (distance p3 (vlax-curve-getendpoint (car (nentselp p3))))) (vlax-curve-getendpoint (car (nentselp p3))) (vlax-curve-getstartpoint (car (nentselp p3)))))
            (while
              (and
                (nentselp p3)
                (/= (cdr (assoc 0 (entget (car (nentselp p3))))) "LWPOLYLINE")
              )
              (vl-cmdf "_.undo" 1)
            )
          )
          ( (= (cdr (assoc 0 (entget (car (nentselp p3))))) "POLYLINE")
            (vl-cmdf "_.explode" (car (nentselp p3)))
            (while (< 0 (getvar (quote cmdactive)))
              (vl-cmdf "")
            )
            (setq p12 (if (< (distance p3 (vlax-curve-getstartpoint (car (nentselp p3)))) (distance p3 (vlax-curve-getendpoint (car (nentselp p3))))) (vlax-curve-getendpoint (car (nentselp p3))) (vlax-curve-getstartpoint (car (nentselp p3)))))
            (while
              (and
                (nentselp p3)
                (/= (cdr (assoc 0 (entget (car (nentselp p3))))) "POLYLINE")
              )
              (vl-cmdf "_.undo" 1)
            )
          )
          ( t
            (setq ent (cdr (assoc 0 (entget (car (nentselp p3))))))
            (setq p12 (if (< (distance p3 (vlax-curve-getstartpoint (car (nentselp p3)))) (distance p3 (vlax-curve-getendpoint (car (nentselp p3))))) (vlax-curve-getendpoint (car (nentselp p3))) (vlax-curve-getstartpoint (car (nentselp p3)))))
            (while
              (and
                (nentselp p3)
                (/= (cdr (assoc 0 (entget (car (nentselp p3))))) ent)
              )
              (vl-cmdf "_.undo" 1)
            )
          )
        )
        t
      )
      (setq en (entsel "\nPick destination polygonal polyline-block to which you want to align..."))
      (setq p4 (osnap (cadr en) "_nea"))
      (setq p2 (osnap (cadr en) "_end"))
      (setq an (angle p2 p4))
      (setq p5 (polar p2 (- an (* 0.5 pi)) *gap*))
      (setq p6 (polar p4 (- an (* 0.5 pi)) *gap*))
      (progn
        (vla-getboundingbox (vlax-ename->vla-object (car en)) (quote ll) (quote ur))
        (mapcar (function set) (list (quote ll) (quote ur)) (mapcar (function safearray-value) (list ll ur)))
        (setq pp (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) ll ur))
      )
    )
    (if
      (and
        (< (distance pp p5) (distance pp p2))
        (< (distance pp p6) (distance pp p4))
      )
      (progn
        (setq p5 (polar p2 (+ an (* 0.5 pi)) *gap*))
        (setq p6 (polar p4 (+ an (* 0.5 pi)) *gap*))
        (vl-cmdf "_.align" (car es) "" "_non" p11 "_non" p5 "_non" p3 "_non" p6 "" "_No")
        (if (and (not (zerop *gap*)) (vlax-invoke (vlax-ename->vla-object (car es)) (quote intersectwith) (vlax-ename->vla-object (car en)) acextendnone))
          (progn
            (vl-cmdf "_.undo" 1)
            (vl-cmdf "_.align" (car es) "" "_non" p12 "_non" p5 "_non" p3 "_non" p6 "" "_No")
          )
        )
      )
      (progn
        (vl-cmdf "_.align" (car es) "" "_non" p11 "_non" p5 "_non" p3 "_non" p6 "" "_No")
        (if (and (not (zerop *gap*)) (vlax-invoke (vlax-ename->vla-object (car es)) (quote intersectwith) (vlax-ename->vla-object (car en)) acextendnone))
          (progn
            (vl-cmdf "_.undo" 1)
            (vl-cmdf "_.align" (car es) "" "_non" p12 "_non" p5 "_non" p3 "_non" p6 "" "_No")
          )
        )
      )
    )
  )
  (*error* nil)
)

HTH.

Regards, M.R.

[marko_ribar]

@omarsvn,

have you tried my version I posted in my previous message? On my side it works as desired...

Why you haven't marked my version as solution also?

What are you expiriencing on your end?

Is something unusual happening?

What do you need to be done and in my code it isn't covered?

[omarsvn]

Hi marko, I just try your version and works really well, we I use it it seem like autoCAD take its time in proccesing all the code it shows the hourglass, I like to store the value of the gap between the pieces, and only change we I need it, so I avoid the extra enter confirming the value

[marko_ribar]

@omarsvn 

Ok, you won... I've slightly changed my posted code to ask for gap only at first time routine is invoked... When you want to change gap distance, enter at command prompt (setq *gap* nil) and restart routine...

So, is it also solution? I am expecting that efforts are not going to be neglected...