Topic: UCS, WCS, trans...Oh My!

[Jeff_M]

UCS, WCS, trans has always baffled me. Even after reading some very good articles by gile and others.

I have a tool to draw a rectangle with diagonal line connecting the opposite corners, adding circles and Mleaders with coordinates at the corners and center of the rectangle, then places all these entities into a Group. All is well when the user is in the WCS, all fails when not. For the life of me I cannot figure out how to get it working while in a UCS (will always be planar to the WCS). The UCS will typically be associated to the view which was set using Dview Twist.
 
It has been a while since I've done much in lisp so this code is likely not very optimal, but it does work. (still need to adjust mleaders so the connection to the Mtext switch direction as needed)

Code - Auto/Visual Lisp: [Select]

1. (defun c:CoordsBox (/ getval p1 p2 p3 p4 doc mspace layer pts pline line ml ang array circle)
2.   (vl-load-com)
3.   (defun getval (x / )
4.     (vlax-safearray->list (vlax-variant-value x))
5.     )
6.   (if (and (setq c1 (getpoint "\nFirst corner: "))
7.            (setq c2 (getcorner c1 "...other corner"))
8.            )
9.     (progn
10.       (setq doc (vla-get-activedocument (vlax-get-acad-object))
11.             mspace (vla-get-modelspace doc)
12.             group (vla-add (vla-get-groups doc) "CoordsBox")
13.             grplist '()
14.             layer "X_Coords_Box") ;;this is a No-Plot layer
15.       (vla-startundomark doc)
16.       (setq layerexists (vl-catch-all-apply '(lambda (x)
17.                                                (vla-item (vla-get-layers doc) layer)
18.                                                )
19.                           (list layer)
20.                           )
21.             )
22.       (if (vl-catch-all-error-p layerexists)
23.         (progn
24.           (setq laymsg (vl-catch-all-error-message layerexists))
25.           (setq lay (vla-add (vla-get-layers doc) layer))
26.           (vla-put-plottable lay :vlax-false)
27.           (vla-put-color lay 211)
28.           )
29.         )
30.       (cond ((and (< (car c1) (car c2)) (> (cadr c1)(cadr c2)))
31.              (setq p1 c1
32.                    p3 c2)
33.              )
34.             ((and (> (car c1) (car c2)) (< (cadr c1)(cadr c2)))
35.              (setq p1 c2
36.                    p3 c1)
37.              )
38.             ((and (< (car c1) (car c2)) (< (cadr c1)(cadr c2)))
39.              (setq p1 (list (car c1) (cadr c2))
40.                    p3 (list (car c2) (cadr c1))
41.                    )
42.              )
43.              ((and (> (car c1) (car c2)) (> (cadr c1)(cadr c2)))
44.              (setq p1 (list (car c2) (cadr c1))
45.                    p3 (list (car c1) (cadr c2))
46.                    )
47.              )
48.             )
49.       (setq p1 (list (car p1)(cadr p1))
50.             p2 (list (car p3)(cadr p1))
51.             p3 (list (car p3)(cadr p3))
52.             p4 (list (car p1)(cadr p3))
53.             )
54.       (setq pts (apply 'append (list p1 p2 p3 p4)))
55.       (setq pline (vlax-invoke mspace 'addlightweightpolyline pts))
56.       (vla-put-layer pline layer)
57.       (vla-put-closed pline :vlax-true)
58.       (setq grplist (cons  pline grplist))
59.       (setq line (vla-addline mspace (setq p1 (vlax-3d-point p1)) (setq p3 (vlax-3d-point p3))))
60.       (vla-put-layer line layer)
61.       (setq grplist (cons  line grplist))
62.       (setq line (vla-addline mspace  (setq p4 (vlax-3d-point p4)) (setq p2 (vlax-3d-point p2))))
63.       (vla-put-layer line layer)
64.       (setq grplist (cons line grplist))
65.       (setq ang (* pi 0.75)
66.             array (vlax-make-safearray vlax-vbdouble '(0 . 1))
67.             )
68.       (mapcar '(lambda (x)
69.                  (setq circle (vla-addcircle mspace x 5.0))
70.                  (vla-put-layer circle layer)
71.                  (setq grplist (cons circle grplist))
72.                  (setq ml (vlax-invoke mspace 'addmleader (apply 'append (list (getval x) (getval (vla-polarpoint (vla-get-utility doc) x ang 20.0)))) 1))
73.                  (vla-put-layer ml layer)
74.                  (setq grplist (cons ml grplist))
75.                  (setq coord (getval x))
76.                  (vla-put-textstring ml (strcat "N" (rtos (cadr coord) 2 2) "\nE" (rtos (car coord) 2 2)))
77.                  (setq ang (- ang (/ pi 2.0)))
78.                  )
79.               (list p1 p2 p3 p4 (vlax-3d-point (vlax-curve-getpointatparam line (/ (vlax-curve-getendparam line) 2))))
80.               )
81.       (vlax-invoke group 'appenditems grplist)
82.       (vla-endundomark doc)
83.       )
84.     )
85.   (princ)
86.   )
87.  

[CHulse]

Not that I expect to be much help, nor do I expect this to be the best solution, but my solution to a similar scenario was to save the current UCS at the beginning of the lisp, then set the UCS to get my desired results ("view" in my case, to get my mleader rotation right), then put the UCS back at the end.

[Jeff_M]

Well I've finally got the UCS issue resolved so all the linework and labeled coordinates come in correctly. I have been unable to get the MLeaders to look look like they should. The 2 white Mleaders were added manually by normal command. Those created in my lisp come in mostly correct, I just have had any success setting the side for the text to be placed on. This is the portion of code for adding the text:

Code - Auto/Visual Lisp: [Select]

1.       (setq left  (vlax-3D-point (trans '(1.0 0.0) 1 0 t))
2.             right (vlax-3D-point (trans '(-1.0 0.0) 1 0 t))
3.       )
4.       (mapcar '(lambda (x y d j)
5.                  (setq circle (vla-addcircle mspace x radius))
6.                  (vla-put-layer circle layer)
7.                  (setq grplist (cons circle grplist))
8.                  (setq ml
9.                         (vlax-invoke
10.                           mspace
11.                           'addmleader
12.                           (apply
13.                             'append
14.                             (list
15.                               (getval x)
16.                               (getval (setq v1 (vla-polarpoint
17.                                                  (vla-get-utility doc)
18.                                                  x
19.                                                  ang
20.                                                  ldrlength
21.                                                )
22.                                       )
23.                               )
24.                               (getval
25.                                 (vla-polarpoint (vla-get-utility doc) v1 d 1.0)
26.                               )
27.                             )
28.                           )
29.                           0
30.                         )
31.                  )
32.                  (vla-put-layer ml layer)
33.                  (setq grplist (cons ml grplist))
34.                  (setq coord (getval x))
35.                  (vla-put-textstring
36.                    ml
37.                    (strcat "N"
38.                            (rtos (cadr coord) 2 2)
39.                            "\nE"
40.                            (rtos (car coord) 2 2)
41.                    )
42.                  )
43.                  (vla-put-textrotation ml 0)
44.                  (vla-put-textjustify ml j)
45.                  (vla-put-doglegged ml :vlax-true)
46.                  (vla-put-textrightattachmenttype ml acattachmentmiddle)
47.                  (vla-put-textleftattachmenttype ml acattachmentmiddle)
48.                  (vla-setdoglegdirection ml 0 y)
49.  
50.                  (setq ang (- ang (/ pi 2.0)))
51.                )
52.               (list p1a
53.                     p2a
54.                     p3a
55.                     p4a
56.                     (vlax-3d-point
57.                       (vlax-curve-getpointatparam
58.                         line
59.                         (/ (vlax-curve-getendparam line) 2)
60.                       )
61.                     )
62.               )
63.               (list left right right left left)
64.               (list (+ ang1 pi) ang1 ang1 (+ ang1 pi) (+ ang1 pi))
65.               ;;direction for second leader segment
66.               (list
67.                 acAttachmentPointMiddleRight
68.                 acAttachmentPointMiddleLeft
69.                 acAttachmentPointMiddleLeft
70.                 acAttachmentPointMiddleLeft
71.                 acAttachmentPointMiddleRight
72.                )
73.       )
74.  

I'm open to any suggestions to get these looking correct.