3-point rectangle not drawing on UCS

[JerryFiedler]

Greetings,

I, like many others, use Lee Mac's fantastic programs.  I will always be grateful for his work.  I am using Lee's "3-Point rectangle" program http://www.lee-mac.com/3pointrectangle.html.  It works flawlessly on the x-y plane in WCS but if I try to create a rectangle on some other UCS plane it draws the rectangle on a plane through the WCS origin.  It allows me to select the points on the UCS but does not draw there.  I have never had any Lee Mac program not work correctly so I can only assume I am doing something wrong.

I would greatly appreciate any help.

[mhupp]

This looks like what your talking about.

 

[JerryFiedler]

Mhupp thanks for your thoughts.  I am setting the UCS by selecting an existing object.  This is definitely setting the correct UCS since I can draw other entities without errors.  However if I try to use Lee's program the rectangle is drawn in the wrong position.  I am sure it is just an issue with one of the "trans" functions but his coding is way over my head so I cannot fix it. 

[mhupp]

Wasn't trying to imply you are doing something wrong. looking at  Lee's description of the program.

 

Quote

3PRD which represent a standard & dynamic version of the program respectively.

 

The dynamic version of the program utilises my GrSnap utility to enable full Object Snap functionality during the dynamic prompt. Furthermore, this program has also been designed to perform successfully under all UCS & View settings.

 

Are you only using the "3PR" command? Would be helpful to post a picture of "the rectangle is drawn in the wrong position".

 

if nothing else maybe @Lee Mac could pop in.

Edited October 4, 2021 by mhupp

[JerryFiedler]

I read Lee's description and that is what makes me think I am doing something wrong.  I get the same results with either command.  I'll post a screen shot tomorrow when I back at my computer.

[JerryFiedler]

Here is a screenshot of my issue.  The new rectangle is drawn at global z=0 instead of the UCS z-value.

[marko_ribar]

Hint :

(entmake) function is missing DXF 38 group code...

Try to fix it by adding it...

Value should be derived from current UCS 3D space orientation in respect to OCS of LWPOLYLINE...

[JerryFiedler]

marko, that is true.  I have added the 38 group to the (entmake) but I am having trouble getting the proper z orientation for any random UCS.  I realize it is just a matter of using the trans function but so far I am still stuck.  I am very determined to solve this problem but I think someone more skilled at lisp will be needed to fix Lee's program.

[mohdtm]

why don't try to set the ucs before applying command.?

[JerryFiedler]

I am already on the UCS when I execute the command.

[mhupp]

With a little bit of fumbling around. I fixed it. Far as I can tell the entmake LWPOLYLINE is only using the x and y cords of the points. makes sense since its only 2d poly.

 

Added two lines. Used what @marko_ribar said but it was dxf code 38 instead of 43. *edit must have misread.

line 70  "elv (caddr (trans pt1 1 ocs))" to get the elevation.

line 171 "(cons 038 elv)" to set the elevation of the polyline in the entmake function.

 

"Lightly Tested"

 

 

;;-----------------------=={ 3-Point Rectangle }==----------------------;;
;;                                                                      ;;
;;  This program enables the user to dynamically construct a rectangle  ;;
;;  defined by three supplied points.                                   ;;
;;                                                                      ;;
;;  The program offers two commands: '3PR' and '3PRD' which represent   ;;
;;  a standard & dynamic version of the program respectively.           ;;
;;                                                                      ;;
;;  Upon issuing either command at the AutoCAD command-line, the user   ;;
;;  is first prompted to specify two points defining one of the two     ;;
;;  pairs of parallel sides of the resulting rectangle.                 ;;
;;                                                                      ;;
;;  Following valid responses to these prompts, the user is then        ;;
;;  prompted for a third point to determine the length and direction    ;;
;;  of the second pair of edges, which are constructed perpendicular    ;;
;;  to the edges defined by the first two points.                       ;;
;;                                                                      ;;
;;  If the dynamic command is used ('3PRD') the program will display a  ;;
;;  real-time preview of the resulting rectangle whilst the user is     ;;
;;  prompted for the third point.                                       ;;
;;                                                                      ;;
;;  The user may exit the program at any time by pressing 'Enter' or    ;;
;;  right-clicking at any prompt.                                       ;;
;;                                                                      ;;
;;  Following valid specification of all three points, the program      ;;
;;  will proceed to construct the defined rectangle using an            ;;
;;  LWPolyline object.                                                  ;;
;;                                                                      ;;
;;  The dynamic version of the program utilises my GrSnap utility to    ;;
;;  enable full Object Snap functionality during the dynamic prompt.    ;;
;;  The latest version and full documentation for this application may  ;;
;;  be found at: http://www.lee-mac.com/grsnap.html                     ;;
;;                                                                      ;;
;;  Finally, this program has been designed to perform successfully     ;;
;;  under all UCS & View settings.                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2013-12-27                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2020-10-31                                      ;;
;;                                                                      ;;
;;  - Modified the dynamic version to incorporate the ability to        ;;
;;    specify a side length when prompted for the third point.          ;;
;;----------------------------------------------------------------------;;

(defun c:3pr  nil (3p-rec nil)) ;; Standard version
(defun c:3prd nil (3p-rec  t )) ;; Dynamic version

;;----------------------------------------------------------------------;;

(defun 3p-rec ( dyn / *error* gr1 gr2 len elv lst msg ocs osf osm pt1 pt2 pt3 pt4 pt5 pt6 str tmp vec )

    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (redraw) (princ)
    )
    
    (if
        (and
            (setq pt1 (getpoint "\nSpecify 1st point: "))
            (setq pt2 (getpoint "\nSpecify 2nd point: " pt1))
            (or   dyn (setq pt3 (getpoint "\nSpecify 3rd point: " pt1)))
            (setq vec (trans (mapcar '- pt2 pt1) 1 0 t)
                  ocs (trans '(0.0 0.0 1.0) 1 0 t)
                  elv (caddr (trans pt1 1 ocs))
                  pt4 (trans pt1 1 vec)
                  pt5 (trans pt2 1 vec)
            )
            (if dyn
                (progn
                    (setq osf (LM:grsnap:snapfunction)
                          osm (getvar 'osmode)
                          msg "\nSpecify 3rd point: "
                          str ""
                    )
                    (princ msg)
                    (while
                        (progn
                            (setq gr1 (grread t 15 0)
                                  gr2 (cadr gr1)
                                  gr1 (car  gr1)
                            )
                            (cond
                                (   (or (= 5 gr1) (= 3 gr1))
                                    (redraw)
                                    (osf gr2 osm)
                                    (setq pt6 (trans gr2 1 vec))
                                    (mapcar '(lambda ( a b ) (grdraw a b 1 1))
                                        (setq lst
                                            (list pt1 pt2
                                                (trans (list (car pt6) (cadr pt6) (caddr pt5)) vec 1)
                                                (trans (list (car pt6) (cadr pt6) (caddr pt4)) vec 1)
                                            )
                                        )
                                        (cons (last lst) lst)
                                    )
                                    (= 5 gr1)
                                )
                                (   (= 2 gr1)
                                    (cond
                                        (   (= 6 gr2)
                                            (if (zerop (logand 16384 (setq osm (setvar 'osmode (boole 6 16384 (getvar 'osmode))))))
                                                (princ "\n<Osnap on>")
                                                (princ "\n<Osnap off>")
                                            )
                                            (princ msg)
                                        )
                                        (   (= 8 gr2)
                                            (if (< 0 (strlen str))
                                                (progn
                                                    (princ "\010\040\010")
                                                    (setq str (substr str 1 (1- (strlen str))))
                                                )
                                            )
                                            t
                                        )
                                        (   (< 32 gr2 127)
                                            (setq str (strcat str (princ (chr gr2))))
                                        )
                                        (   (member gr2 '(13 32))
                                            (cond
                                                (   (= "" str) nil)
                                                (   (setq gr2 (LM:grsnap:parsepoint pt1 str))
                                                    (setq osm 16384)
                                                    nil
                                                )
                                                (   (setq tmp (LM:grsnap:snapmode str))
                                                    (setq osm tmp
                                                          str ""
                                                    )
                                                )
                                                (   (and pt6
                                                        (setq len (distof str))
                                                        (setq pt6 (list (car pt6) (cadr pt6) (caddr pt4)))
                                                        (not (equal 0.0 (setq tmp (distance pt4 pt6)) 1e-8))
                                                    )
                                                    (setq gr2 (trans (mapcar '(lambda ( a b ) (+ b (* len (/ (- a b) tmp)))) pt6 pt4) vec 1)
                                                          osm 16384
                                                    )
                                                    nil
                                                )
                                                (   (setq str "")
                                                    (princ (strcat "\n2D / 3D Point Required." msg))
                                                )
                                            )
                                        )
                                    )
                                )
                            )
                        )
                    )
                    (if (listp gr2)
                        (setq pt6 (trans (osf gr2 osm) 1 vec))
                    )
                )
                (setq pt6 (trans pt3 1 vec))
            )
        )
        (entmake
            (list
               '(000 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               '(090 . 4)
               '(070 . 1)
                (cons 038 elv)
                (cons 010 (trans pt1 1 ocs))
                (cons 010 (trans pt2 1 ocs))
                (cons 010 (trans (list (car pt6) (cadr pt6) (caddr pt5)) vec ocs))
                (cons 010 (trans (list (car pt6) (cadr pt6) (caddr pt4)) vec ocs))
                (cons 210 ocs)
            )
        )
    )
    (redraw) (princ)
)

;; Object Snap for grread: Snap Function  -  Lee Mac
;; Returns: [fun] A function requiring two arguments:
;; p - [lst] UCS Point to be snapped
;; o - [int] Object Snap bit code
;; The returned function returns either the snapped point (displaying an appropriate snap symbol)
;; or the supplied point if the snap failed for the given Object Snap bit code.

(defun LM:grsnap:snapfunction ( )
    (eval
        (list 'lambda '( p o / q )
            (list 'if '(zerop (logand 16384 o))
                (list 'if
                   '(setq q
                        (cdar
                            (vl-sort
                                (vl-remove-if 'null
                                    (mapcar
                                        (function
                                            (lambda ( a / b )
                                                (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))
                                                    (list (distance p b) b (car a))
                                                )
                                            )
                                        )
                                       '(
                                            (0001 . "_end")
                                            (0002 . "_mid")
                                            (0004 . "_cen")
                                            (0008 . "_nod")
                                            (0016 . "_qua")
                                            (0032 . "_int")
                                            (0064 . "_ins")
                                            (0128 . "_per")
                                            (0256 . "_tan")
                                            (0512 . "_nea")
                                            (2048 . "_app")
                                            (8192 . "_par")
                                        )
                                    )
                                )
                               '(lambda ( a b ) (< (car a) (car b)))
                            )
                        )
                    )
                    (list 'LM:grsnap:displaysnap '(car q)
                        (list 'cdr
                            (list 'assoc '(cadr q)
                                (list 'quote
                                    (LM:grsnap:snapsymbols
                                        (atoi (cond ((getenv "AutoSnapSize")) ("5")))
                                    )
                                )
                            )
                        )
                        (LM:OLE->ACI
                            (if (= 1 (getvar 'cvport))
                                (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))
                                (atoi (cond ((getenv  "Model AutoSnap Color")) ("104193")))
                            )
                        )
                    )
                )
            )
           '(cond ((car q)) (p))
        )
    )
)

;; Object Snap for grread: Display Snap  -  Lee Mac
;; pnt - [lst] UCS point at which to display the symbol
;; lst - [lst] grvecs vector list
;; col - [int] ACI colour for displayed symbol
;; Returns nil

(defun LM:grsnap:displaysnap ( pnt lst col / scl )
    (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
          pnt (trans pnt 1 2)
    )
    (grvecs (cons col lst)
        (list
            (list scl 0.0 0.0 (car  pnt))
            (list 0.0 scl 0.0 (cadr pnt))
            (list 0.0 0.0 scl 0.0)
           '(0.0 0.0 0.0 1.0)
        )
    )
)

;; Object Snap for grread: Snap Symbols  -  Lee Mac
;; p - [int] Size of snap symbol in pixels
;; Returns: [lst] List of vector lists describing each Object Snap symbol

(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )
    (setq -p (- p) q (1+  p)
          -q (- q) r (+ 2 p)
          -r (- r) i (/ pi 6.0)
           a 0.0
    )
    (repeat 12
        (setq l (cons (list (* r (cos a)) (* r (sin a))) l)
              a (- a i)
        )
    )
    (setq c (apply 'append (mapcar 'list (cons (last l) l) l)))
    (list
        (list 1
            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
        )
        (list 2
            (list -r -q) (list 0  r) (list 0  r) (list r -q)
            (list -p -p) (list p -p) (list p -p) (list 0  p) (list 0  p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list 0  q) (list 0  q) (list -q -q)
        )
        (cons 4 c)
        (vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)
        (list 16
            (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)
            (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)
            (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)
        )
        (list 32
            (list  r r) (list -r -r) (list  r q) (list -q -r) (list  q r) (list -r -q)
            (list -r r) (list  r -r) (list -q r) (list  r -q) (list -r q) (list  q -r)
        )
        (list 64
            '( 0  1) (list  0  p) (list  0  p) (list -p  p) (list -p  p) (list -p -1) (list -p -1) '( 0 -1)
            '( 0 -1) (list  0 -p) (list  0 -p) (list  p -p) (list  p -p) (list  p  1) (list  p  1) '( 0  1)
            '( 1  2) (list  1  q) (list  1  q) (list -q  q) (list -q  q) (list -q -2) (list -q -2) '(-1 -2)
            '(-1 -2) (list -1 -q) (list -1 -q) (list  q -q) (list  q -q) (list  q  2) (list  q  2) '( 1  2)
        )
        (list 128
            (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))
            (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))
            (list -p q) (list -p -p) (list -p -p) (list q -p)
            (list -q q) (list -q -q) (list -q -q) (list q -q)
        )
        (vl-list* 256 (list -r r)  (list r r) (list -r (1+ r)) (list r (1+ r)) c)
        (list 512
            (list -p -p) (list  p -p) (list -p  p) (list p p) (list -q -q) (list  q -q)
            (list  q -q) (list -q  q) (list -q  q) (list q q) (list  q  q) (list -q -q)
        )
        (list 2048
            (list   -p     -p) (list    p      p) (list   -p      p) (list    p     -p)
            (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)
            (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)
            (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)
            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
        )
        (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))
    )
)

;; Object Snap for grread: Parse Point  -  Lee Mac
;; bpt - [lst] Basepoint for relative point input, e.g. @5,5
;; str - [str] String representing point input
;; Returns: [lst] Point represented by the given string, else nil

(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )
 
    (defun str->lst ( str / pos )
        (if (setq pos (vl-string-position 44 str))
            (cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))
            (list str)
        )
    )

    (if (wcmatch str "`@*")
        (setq str (substr str 2))
        (setq bpt '(0.0 0.0 0.0))
    )           

    (if
        (and
            (setq lst (mapcar 'distof (str->lst str)))
            (vl-every 'numberp lst)
            (< 1 (length lst) 4)
        )
        (mapcar '+ bpt lst)
    )
)

;; Object Snap for grread: Snap Mode  -  Lee Mac
;; str - [str] Object Snap modifier
;; Returns: [int] Object Snap bit code for the given modifier, else nil

(defun LM:grsnap:snapmode ( str )
    (vl-some
        (function
            (lambda ( x )
                (if (wcmatch (car x) (strcat (strcase str t) "*"))
                    (progn
                        (princ (cadr x)) (caddr x)
                    )
                )
            )
        )
       '(
            ("endpoint"      " of " 00001)
            ("midpoint"      " of " 00002)
            ("center"        " of " 00004)
            ("node"          " of " 00008)
            ("quadrant"      " of " 00016)
            ("intersection"  " of " 00032)
            ("insert"        " of " 00064)
            ("perpendicular" " to " 00128)
            ("tangent"       " to " 00256)
            ("nearest"       " to " 00512)
            ("appint"        " of " 02048)
            ("parallel"      " to " 08192)
            ("none"          ""     16384)
        )
    )
)

;; OLE -> ACI  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->ACI ( c )
    (apply 'LM:RGB->ACI (LM:OLE->RGB c))
)

;; OLE -> RGB  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
)

;; RGB -> ACI  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->ACI ( r g b / c o )
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
        (progn
            (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
            (vlax-release-object o)
            (if (vl-catch-all-error-p c)
                (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
                c
            )
        )
    )
)

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
    (strcat
        "\n:: 3P-Rec.lsp | Version 1.1 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: \"3PR\" - Standard | \"3PRD\" - Dynamic ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

 

Edited October 6, 2021 by mhupp
updated

[JerryFiedler]

Thank you mhupp.  I tested your revision and it works on all planes.  Problem Solved!

 

[Lee Mac]

Thank you for bringing this issue to my attention - I have now corrected the code on my site.