Block rotation by layer

[Fleww]

Is there lisp to rotate all multiple blocks from one layer(many same blocks on just one layer) to first polyline(in specific layer) to just match up with them. I saw alot lisps for this but none for multiple blocks its all just click by click i need something more automatic. it dont need to be perfect.

[dlanorh]

@Fleww 

I have sorted the LWPOLYLINE with elevation problem. However some of the blocks in 222.dwg are not being processed because they have a different level to the lwpolyline on which, I assume, they are supposed to sit. This causes them to fail the check because of the difference in level. Would you like the revised lisp to rotate these blocks and move the down/up to the polyline?

[Fleww]

They have to stay on totaly same position where they are now just need to be rotated good.

[dlanorh · Accepted solution]

OK. Here is revised Lisp

(defun rh:ss2lst( ss opt / cnt lst)
  (cond ( (and ss (= (type ss) 'PICKSET))
          (repeat (setq cnt (sslength ss)) (setq lst (cons (ssname ss (setq cnt (1- cnt))) lst)))
          (if opt (setq lst (mapcar 'vlax-ename->vla-object lst)))
        )
        ( (or (not ss) (/= (type ss) 'PICKSET)) (setq lst -1))
  );end_cond
);end_defun

(defun rh:align_ang (itm p) (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv itm p)))

(defun rh:assoc_val (dxf_code ent) (if (= (type dxf_code) 'INT) (cdr (assoc dxf_code (entget ent)))))

(vl-load-com)

(defun C:RB2L (/ *error* c_doc ent lyr bname fuzz b_lst pt z i_pt l_lst e ang e_lst)

  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        ent (car (entsel "\nSelect Typical Block to be Rotated : "))
        lyr (rh:assoc_val 8 ent)
        bname (rh:assoc_val 2 ent)
        fuzz 0.001
  );end_setq

  ;(vla-zoomall (vlax-get-acad-object))

  (setq b_lst (rh:ss2lst (ssget "_X" (list '(0 . "INSERT") (cons 2 bname) (cons 8 lyr))) T))
  
  (cond (b_lst
          (setq l_lst (rh:ss2lst (ssget "_X" '((0 . "*LINE"))) T))
          (foreach blk b_lst
            (setq pt (vlax-get blk 'insertionpoint)
                  z (caddr pt)
                  i_pt (reverse (cons 0.0 (cdr (reverse pt))))
            );end_setq
            (foreach l_obj l_lst
              (if (/= (setq e (vlax-get-property l_obj 'elevation)) 0.0) (vlax-put-property l_obj 'elevation 0.0))
              (cond ( (equal i_pt (vlax-curve-getstartpoint l_obj) fuzz)
                      (setq ang (rh:align_ang l_obj 0))
                      (vlax-put-property blk 'rotation ang)
                      (if (/= z e) (setq e_lst (cons (list i_pt e blk) e_lst)))
                    )
                    ( (equal i_pt (vlax-curve-getendpoint l_obj) fuzz)
                      (setq ang (+ (rh:align_ang l_obj (vlax-curve-getendparam l_obj)) pi))
                      (vlax-put-property blk 'rotation ang)
                    )
              );end_cond
              (vlax-put l_obj 'elevation e)
            );end_foreach
          );end_foreach
        )
  );end_cond
  (princ)
);end_defun

[ВeekeeCZ]

Why you don't remove a Z coord just for comparison?

(equal (cdr (reverse i_pt)) (cdr (reverse (vlax-curve-getstartpoint l_obj))) fuzz)

[dlanorh]

---

@ВeekeeCZ wrote:

Why you don't remove a Z coord just for comparison?

(equal (cdr (reverse i_pt)) (cdr (reverse (vlax-curve-getstartpoint l_obj))) fuzz)

---

I flatten the blocks insertion point coordinates and change the lwpolyline elevation to 0 then restore. I didn't think about doing that in the comparison. Cheers :clinking_beer_mugs:

i_pt (reverse (cons 0.0 (cdr (reverse pt))))

[ВeekeeCZ]

Yeah, I know what you did and found that unnecessary. But the result is what counts.

[dlanorh]

---

@ВeekeeCZ wrote:

Yeah, I know what you did and found that unnecessary. But the result is what counts.

---

I initially wrote it that way to lower/raise the block onto the end of the polyline if required, but the OP didn't want that so i removed most of that code.

[Fleww]

Thank you soo much !!!

[Fleww]

You helped enough thank you so much!

Do you know maybe why in some drawing I got this error:

Select Typical Block to be Rotated :
Oops an Error : ActiveX Server returned the error: unknown name: ELEVATION occurred.
Command:

[dlanorh · Accepted solution]

Apologies, I missed this bit. The lisp finds all lines, polylines etc in the drawing. Only LWpolylines have an elevation property, so another line type has been selected and is causing the error

If the lines to be aligned with are always LWPolyline, and can't wait a day or two then find this line

(setq l_lst (rh:ss2lst (ssget "_X" '((0 . "*LINE"))) T))

and change the red bit to this

(setq l_lst (rh:ss2lst (ssget "_X" '((0 . "LWPOLYLINE"))) T))

This will then only select lightweight polylines, and prevent the error occuring. Otherwise I will post an update when I get back to the office.

[Fleww]

PERFECT! Thank you !

[Fleww]

I got new question and problem, when I try to do this I got this error:

Select Typical Block to be Rotated :
Oops an Error : ActiveX Server returned the error: unknown name: ELEVATION occurred.
What to do? 😕

[Fleww]

Oops an Error : AutoCAD.Application occurred.

When i set it for polyline...

[Kent1Cooper · Accepted solution]

If you are using the code from Message 23, did you make the correction in Message 30?  It is in response to Message 29, which is about the same error message.

[EDIT:  Now I notice that it's not only the same error message, but from the same person.  Did you revert to using an old copy of the code, from before the correction that Message 31 said was perfect?]