Topic: Rotate North Block to Viewport WCS

[Shoey]

Hello All

I have the lisp code below, which aligns a block in paper space (in this case a north point block) to the WCS (north) of the model space view.
I would like modifications to this but need help if anybody can help?
The modification i would like is for an error trap.
I would like it to loop if i miss or select anything but a viewport or the polyline boundary of the polygon viewport.
And also if i select anything but the block it errors.
Any help appreciated.

Code: [Select]

;;Wriiten by Mike Roberts
(defun c:RN()
   (setq tw(entget(car(entsel" Select a Viewport:"))))
   (setq new (cdr (assoc 0 tw)))
 (cond
                 ((= new "VIEWPORT")(setq rt(cdr(assoc 51 tw))))
 ((= new "LWPOLYLINE")(setq temp (entget(cdr (assoc 330 tw))))(setq rt(cdr(assoc 51 temp))))
              )
   (setq en(car(entsel" Select North Arrow: ")))
   (setq elist(entget en))
   (setq elist(subst (cons 50 rt)(assoc 50 elist) elist))
   (entmod elist)
   (princ)
 )
Many thanks

[Lee Mac]

Try the following instead:

Code - Auto/Visual Lisp: [Select]

1. (defun c:rn ( / ent obj sel )
2.     (if (= 1 (getvar 'cvport))
3.         (progn
4.             (while
5.                 (progn (setvar 'errno 0) (princ "\nSelect a viewport: ")
6.                     (not
7.                         (or (setq sel (ssget "_+.:E:S" '((0 . "VIEWPORT"))))
8.                             (= 52 (getvar 'errno))
9.                         )
10.                     )
11.                 )
12.                 (princ "\nMissed, try again.")
13.             )
14.             (if sel
15.                 (while
16.                     (progn
17.                         (setvar 'errno 0)
18.                         (setq ent (car (entsel "\nSelect north arrow: ")))
19.                         (cond
20.                             (   (= 7 (getvar 'errno))
21.                                 (princ "\nMissed, try again.")
22.                             )
23.                             (   (null ent) nil)
24.                             (   (/= "INSERT" (cdr (assoc 0 (entget ent))))
25.                                 (princ "\nThe selected object is not a block.")
26.                             )
27.                             (   (not (vlax-write-enabled-p (setq obj (vlax-ename->vla-object ent))))
28.                                 (princ "\nThe selected block is on a locked layer.")
29.                             )
30.                             (   (vla-put-rotation obj (cdr (assoc 51 (entget (ssname sel 0))))))
31.                         )
32.                     )
33.                 )
34.             )
35.         )
36.         (princ "\nCommand only available in Paperspace.")
37.     )
38.     (princ)
39. )
40. (vl-load-com) (princ)

[ronjonp]

There is also THIS from many moons ago.

[Shoey]

Thanks to Lee Mac and Ronjonp.
Appreciate your time and feedback.