Rectangle lisp.Little help !

November 8, 2013

ok Thank you

November 8, 2013

Attached is an example of the dynamic version from my previous post implemented using DynDraw by Alexander Rivilis.

Dyn-3P-Rect.lsp

November 9, 2013

With dynamic effect:

Good stuff, Lee

I hope you don't mind if I borrow your code to play without the use of DynDraw.

(defun c:MyRec ( / nv oc p1 p2 p3 p4 p5 pl p5a os AScol ASsize )
   (if
       (and
           (setq p1 (getpoint "\n1st point: "))
           (setq p2 (getpoint "\n2nd point: " p1))
       )
       (progn
           (setq nv (trans (mapcar '- p2 p1) 1 0 t)
                 oc (trans '(0.0 0.0 1.0) 1 0 t)
                 p3 (trans p1 1 nv)
                 p4 (trans p2 1 nv)
           )

           ;AutoSnap marker color
           (setq AScol (LM:OLE->RGB (atoi (getenv "Model AutoSnap Color"))))
           (setq AScol (LM:RGB->ACI (car AScol) (cadr AScol) (caddr AScol)))

           ;AutoSnap marker size
           (setq ASsize (* (atoi (getenv "AutoSnapSize")) 0.002))

           (princ "\n3rd point: ")
           (while (= 5 (car (setq p5 (grread t 13 0))))
               (redraw)
               (and (setq os (osmode2str)) (setq p5a (osnap (cadr p5) os)))
               (if p5a
                   (progn
                       (ASvector p5a AScol)
                       (setq p5a (trans p5a 1 nv))
                       (mapcar '(lambda ( a b ) (grdraw a b 1 1))
                           (setq pl
                               (list p1 p2
                                   (trans (list (car p5a) (cadr p5a) (caddr p4)) nv 1)
                                   (trans (list (car p5a) (cadr p5a) (caddr p3)) nv 1)
                               )
                           )
                           (cons (last pl) pl)
                       )                       
                   )
                   (progn
                       (setq p5 (trans (cadr p5) 1 nv))
                       (mapcar '(lambda ( a b ) (grdraw a b 1 1))
                           (setq pl
                               (list p1 p2
                                   (trans (list (car p5) (cadr p5) (caddr p4)) nv 1)
                                   (trans (list (car p5) (cadr p5) (caddr p3)) nv 1)
                               )
                           )
                           (cons (last pl) pl)
                       )
                   )
               )
           )
           (if
               (and
                   (listp (cadr p5))
                   (setq p5 (trans (cadr p5) 1 nv))
               )
               (progn
                   (and p5a (setq p5 p5a))
                   (entmake
                       (list
                           '(000 . "LWPOLYLINE")
                           '(100 . "AcDbEntity")
                           '(100 . "AcDbPolyline")
                           '(090 . 4)
                           '(070 . 1)
                           (cons 010 (trans p1 1 oc))
                           (cons 010 (trans p2 1 oc))
                           (cons 010 (trans (list (car p5) (cadr p5) (caddr p4)) nv oc))
                           (cons 010 (trans (list (car p5) (cadr p5) (caddr p3)) nv oc))
                           (cons 210 oc)
                       )
                   )
               )
           )        
           (redraw)
       )
   )
   (princ)
)

;----------------------------------------------------------
;  Return the current osnap mode in the form of a string.  
;         i.e.:  osmode = 37 --> "_end,_cen,_int"          
;           Gian Paolo Cattaneo - 09/11/2013               
;----------------------------------------------------------
(defun osmode2str ( / osm)
   (if (> (getvar 'osmode) 0)
       (mapcar
           '(lambda (a b)
                (if (= a (logand a (getvar 'osmode)))
                    (if osm
                        (setq osm (strcat osm "," b))
                        (setq osm b)
                    )
                )
            )
           '(1 2 4 8 16 32 64 128 256 512)
           '("_end"    "_mid"    "_cen"    "_nod"    "_qua"
             "_int"    "_ins"    "_per"    "_tan"    "_nea"
            )
       )
   )
   osm
)

;----------------------------------------------------------
;; OLE -> RGB - Lee Mac 2011                               
;; Args: c - OLE Colour                                    
;----------------------------------------------------------
(defun LM:OLE->RGB ( c )
 (list
   (lsh (lsh (fix c) 24) -24)
   (lsh (lsh (fix c) 16) -24)
   (lsh (lsh (fix c)   -24)
 )
)

;----------------------------------------------------------
;; RGB -> ACI - Lee Mac 2011                               
;; Args: r,g,b - Red,Green,Blue values                     
;----------------------------------------------------------
(defun LM:RGB->ACI ( r g b / cObj aci ) (vl-load-com)
 (if
   (and
     (setq cObj
       (vla-getInterfaceObject (vlax-get-acad-object)
         (strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2))
       )
     )
     (not
       (vl-catch-all-error-p
         (vl-catch-all-apply 'vla-SetRGB (list cObj r g b))
       )
     )
   )
   (setq aci (vla-get-ColorIndex cObj))
 )
 (if cObj (vlax-release-object cObj))
 aci
)

;_____________________credit: ronjonp______________________
(defun ASvector (pt: color /  L L- c1 c2 *1 *2 *3 *4 *5 *6
                             *7 *8 *9 *10 *11 *12)
   (setq L  (* (* 1.3 ASsize) (getvar 'viewsize))
         L- (* 0.9 L) 
         c1 (polar pt: pi (* L 0.06))
         c2 (polar pt: 0.0 (* L 0.06))
         *1 (polar c1 0.785 L)
         *2 (polar c1 2.356 L-)
         *3 (polar c1 3.926 L-)
         *4 (polar c1 5.498 L)
         *5 (polar c2 0.785 L-)
         *6 (polar c2 2.356 L)
         *7 (polar c2 3.926 L)
         *8 (polar c2 5.498 L-)
         *9 (polar pt: 0.785 L)
         *10 (polar pt: 2.356 L)
         *11 (polar pt: 3.926 L)
         *12 (polar pt: 5.498 L)
   )
   (grvecs (list color *2 *5 *3 *8 *6 *7 *1 *4))
   (grvecs (list color *9 *10 *11 *12 *9 *12 *10 *11))
   (grvecs (list color *1 *3 *2 *4 *5 *7 *6 *8 *9 *11 *10 *12))
)

November 9, 2013

nice job

November 9, 2013

Good stuff, Lee

Thank you Gian!

I hope you don't mind if I borrow your code to play without the use of DynDraw.

Certainly - go ahead

For what its worth, here is how I would write the program to include a form of Object Snap without DynDraw:

(the following uses several functions from my Draw Grid program)

[color=GREEN];; Dynamic 3-Point Rectangle  -  Lee Mac[/color]
[color=GREEN];; Allows the user to construct a rectangle defined by three picked points,[/color]
[color=GREEN];; with the 3rd point displayed dynamically.[/color]

([color=BLUE]defun[/color] c:myrec ( [color=BLUE]/[/color] snap nv oc p1 p2 p3 p4 p5 pl )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] p1 ([color=BLUE]getpoint[/color] [color=MAROON]"\n1st point: "[/color]))
           ([color=BLUE]setq[/color] p2 ([color=BLUE]getpoint[/color] [color=MAROON]"\n2nd point: "[/color] p1))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] nv ([color=BLUE]trans[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] p2 p1) 1 0 [color=BLUE]t[/color])
                 oc ([color=BLUE]trans[/color] '(0.0 0.0 1.0) 1 0 [color=BLUE]t[/color])
                 p3 ([color=BLUE]trans[/color] p1 1 nv)
                 p4 ([color=BLUE]trans[/color] p2 1 nv)
           )
           ([color=BLUE]if[/color] ([color=BLUE]zerop[/color] ([color=BLUE]logand[/color] 16384 ([color=BLUE]getvar[/color] 'osmode)))
               ([color=BLUE]eval[/color]
                   ([color=BLUE]list[/color] '[color=BLUE]defun[/color] 'snap '( p [color=BLUE]/[/color] q )
                       ([color=BLUE]list[/color] '[color=BLUE]if[/color] ([color=BLUE]list[/color] '[color=BLUE]setq[/color] 'q ([color=BLUE]list[/color] '[color=BLUE]osnap[/color] 'p (LM:getosmode ([color=BLUE]getvar[/color] 'osmode))))
                           ([color=BLUE]list[/color] 'LM:grX 'q ([color=BLUE]atoi[/color] ([color=BLUE]getenv[/color] [color=MAROON]"AutoSnapSize"[/color]))
                               (LM:OLE->ACI
                                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))
                                       ([color=BLUE]atoi[/color] ([color=BLUE]getenv[/color] [color=MAROON]"Layout AutoSnap Color"[/color]))
                                       ([color=BLUE]atoi[/color] ([color=BLUE]getenv[/color] [color=MAROON]"Model AutoSnap Color"[/color]))
                                   )
                              )
                           )
                          '([color=BLUE]setq[/color] q p)
                       )
                       'q
                   )
               )
               ([color=BLUE]defun[/color] snap ( p ) p)
           )
           ([color=BLUE]princ[/color] [color=MAROON]"\n3rd point: "[/color])
           ([color=BLUE]while[/color] ([color=BLUE]=[/color] 5 ([color=BLUE]car[/color] ([color=BLUE]setq[/color] p5 ([color=BLUE]grread[/color] [color=BLUE]t[/color] 13 0))))
               ([color=BLUE]redraw[/color])
               ([color=BLUE]setq[/color] p5 ([color=BLUE]trans[/color] (snap ([color=BLUE]cadr[/color] p5)) 1 nv))
               ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]grdraw[/color] a b 1 1))
                   ([color=BLUE]setq[/color] pl
                       ([color=BLUE]list[/color] p1 p2
                           ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] p5) ([color=BLUE]cadr[/color] p5) ([color=BLUE]caddr[/color] p4)) nv 1)
                           ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] p5) ([color=BLUE]cadr[/color] p5) ([color=BLUE]caddr[/color] p3)) nv 1)
                       )
                   )
                   ([color=BLUE]cons[/color] ([color=BLUE]last[/color] pl) pl)
               )
           )
           ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]listp[/color] ([color=BLUE]cadr[/color] p5)) ([color=BLUE]setq[/color] p5 ([color=BLUE]trans[/color] (snap ([color=BLUE]cadr[/color] p5)) 1 nv)))
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(000 . [color=MAROON]"LWPOLYLINE"[/color])
                      '(100 . [color=MAROON]"AcDbEntity"[/color])
                      '(100 . [color=MAROON]"AcDbPolyline"[/color])
                      '(090 . 4)
                      '(070 . 1)
                       ([color=BLUE]cons[/color] 010 ([color=BLUE]trans[/color] p1 1 oc))
                       ([color=BLUE]cons[/color] 010 ([color=BLUE]trans[/color] p2 1 oc))
                       ([color=BLUE]cons[/color] 010 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] p5) ([color=BLUE]cadr[/color] p5) ([color=BLUE]caddr[/color] p4)) nv oc))
                       ([color=BLUE]cons[/color] 010 ([color=BLUE]trans[/color] ([color=BLUE]list[/color] ([color=BLUE]car[/color] p5) ([color=BLUE]cadr[/color] p5) ([color=BLUE]caddr[/color] p3)) nv oc))
                       ([color=BLUE]cons[/color] 210 oc)
                   )
               )
           )
           ([color=BLUE]redraw[/color])
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Get Object Snap String  -  Lee Mac[/color]
[color=GREEN];; Returns a comma-delimited string of active Object Snap modes[/color]
[color=GREEN];; os - [int] OSMODE bit-coded integer[/color]

([color=BLUE]defun[/color] LM:getosmode ( os [color=BLUE]/[/color] lst )
   ([color=BLUE]foreach[/color] mode
      '(
           (0001 . [color=MAROON]"_end"[/color])
           (0002 . [color=MAROON]"_mid"[/color])
           (0004 . [color=MAROON]"_cen"[/color])
           (0008 . [color=MAROON]"_nod"[/color])
           (0016 . [color=MAROON]"_qua"[/color])
           (0032 . [color=MAROON]"_int"[/color])
           (0064 . [color=MAROON]"_ins"[/color])
           (0128 . [color=MAROON]"_per"[/color])
           (0256 . [color=MAROON]"_tan"[/color])
           (0512 . [color=MAROON]"_nea"[/color])
           (1024 . [color=MAROON]"_qui"[/color])
           (2048 . [color=MAROON]"_app"[/color])
           (4096 . [color=MAROON]"_ext"[/color])
           (8192 . [color=MAROON]"_par"[/color])
       )
       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]zerop[/color] ([color=BLUE]logand[/color] ([color=BLUE]car[/color] mode) os)))
           ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] [color=MAROON]","[/color] ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] mode) lst)))
       )
   )
   ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]cdr[/color] lst))
)

[color=GREEN];; GrX  -  Lee Mac[/color]
[color=GREEN];; Displays an 'X' at the supplied point.[/color]
[color=GREEN];; p - [lst] UCS point for symbol[/color]
[color=GREEN];; s - [int] Size of symbol in pixels[/color]
[color=GREEN];; c - [int] ACI colour of symbol[/color]

([color=BLUE]defun[/color] LM:grX ( p s c [color=BLUE]/[/color] -s r q )
   ([color=BLUE]setq[/color] -s ([color=BLUE]-[/color] s)
          r ([color=BLUE]/[/color] ([color=BLUE]getvar[/color] 'viewsize) ([color=BLUE]cadr[/color] ([color=BLUE]getvar[/color] 'screensize)))
          q ([color=BLUE]trans[/color] p 1 3)
   )
   ([color=BLUE]grvecs[/color]
       ([color=BLUE]list[/color] c
           ([color=BLUE]list[/color] -s      -s)  ([color=BLUE]list[/color] s       s)
           ([color=BLUE]list[/color] -s  ([color=BLUE]1+[/color] -s)) ([color=BLUE]list[/color] ([color=BLUE]1-[/color] s)  s)
           ([color=BLUE]list[/color] ([color=BLUE]1+[/color] -s) -s)  ([color=BLUE]list[/color] s   ([color=BLUE]1-[/color] s))
           
           ([color=BLUE]list[/color] -s       s)  ([color=BLUE]list[/color] s      -s)
           ([color=BLUE]list[/color] -s   ([color=BLUE]1-[/color] s)) ([color=BLUE]list[/color] ([color=BLUE]1-[/color] s) -s)
           ([color=BLUE]list[/color] ([color=BLUE]1+[/color] -s)  s)  ([color=BLUE]list[/color] s  ([color=BLUE]1+[/color] -s))
       )
       ([color=BLUE]list[/color]
           ([color=BLUE]list[/color] r  0. 0. ([color=BLUE]car[/color]  q))
           ([color=BLUE]list[/color] 0. r  0. ([color=BLUE]cadr[/color] q))
           ([color=BLUE]list[/color] 0. 0. r  0.)
           ([color=BLUE]list[/color] 0. 0. 0. 1.)
       )
   )
   p
)

[color=GREEN];; OLE -> ACI  -  Lee Mac[/color]
[color=GREEN];; Args: c - [int] OLE Colour[/color]

([color=BLUE]defun[/color] LM:OLE->ACI ( c )
   ([color=BLUE]apply[/color] 'LM:RGB->ACI (LM:OLE->RGB c))
)

[color=GREEN];; OLE -> RGB  -  Lee Mac[/color]
[color=GREEN];; Args: c - [int] OLE Colour[/color]

([color=BLUE]defun[/color] LM:OLE->RGB ( c )
   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]lsh[/color] ([color=BLUE]lsh[/color] ([color=BLUE]fix[/color] c) x) -24)) '(24 16 )
)

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

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

[color=GREEN];; Application Object  -  Lee Mac[/color]
[color=GREEN];; Returns the VLA Application Object[/color]

([color=BLUE]defun[/color] LM:acapp [color=BLUE]nil[/color]
   ([color=BLUE]eval[/color] ([color=BLUE]list[/color] '[color=BLUE]defun[/color] 'LM:acapp '[color=BLUE]nil[/color] ([color=BLUE]vlax-get-acad-object[/color])))
   (LM:acapp)
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

November 9, 2013

nice job to all

Thanks :beer:

Website · November 9, 2013

All set now.

November 10, 2013

;----------------------------------------------------------
;  Return the current osnap mode in the form of a string.  
;         i.e.:  osmode = 37 --> "_end,_cen,_int"          
;           Gian Paolo Cattaneo - 09/11/2013               
;----------------------------------------------------------
(defun osmode2str ( / osm).....]

(defun LM:getosmode ( os / lst )

(foreach mode

Hats off to you both

November 10, 2013

.... here is how I would write the program ....

"State of the art"

Hats off to you both

:)

Lee...

and GP...

November 10, 2013

Thank you all for your flattering comments

@GP: thank you - it was your modification that provided the inspiration to implement the Object Snap without DynDraw

November 10, 2013

Thank you all for your flattering comments

I addition, sorry

Join with this opinion, move in this flow

Very glad with your progressive level

Oleg

November 10, 2013

Hi Lee, I've tried to implement your method for drawing star - it's also your code, but with implemented your method you showed here on rectangle... I have an issue : snap marker isn't showing probably due to usage of (grvecs) twicely - one for correct dynamic effect of star and the other for snap marker... So can you fix this or it couldn't be fixed???

Here is your modified star.lsp :

CODE REMOVED DUE TO ITS LACK TO DISPLAY SNAP MARKER

Thanks, M.R.

Edited November 10, 2013 by marko_ribar
code removed

November 10, 2013

It seems that 2x grvecs isn't the issue; I tried (grdraw) for LM:grX, but no success...

;; GrX  -  Lee Mac
;; Displays an 'X' at the supplied point.
;; p - [lst] UCS point for symbol
;; s - [int] Size of symbol in pixels
;; c - [int] ACI colour of symbol

(defun LM:grX ( p s c / -s r j )
   (setq -s (- s)
          r (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
          j p
   )
   (grdraw (mapcar '+ j (list (* r -s) (* r -s))) (mapcar '+ j (list (* r s) (* r s))) c)
   (grdraw (mapcar '+ j (list (* r -s) (* r (1+ -s)))) (mapcar '+ j (list (* r (1- s)) (* r s))) c)
   (grdraw (mapcar '+ j (list (* r (1+ -s)) (* r -s))) (mapcar '+ j (list (* r s) (* r (1- s)))) c)
   
   (grdraw (mapcar '+ j (list (* r -s) (* r s))) (mapcar '+ j (list (* r s) (* r -s))) c)
   (grdraw (mapcar '+ j (list (* r -s) (* r (1- s)))) (mapcar '+ j (list (* r (1- s)) (* r -s))) c)
   (grdraw (mapcar '+ j (list (* r (1+ -s)) (* r s))) (mapcar '+ j (list (* r s) (* r (1+ -s)))) c)

   p
)

P.S. This mod works for rectangle case... So, what's the problem with star?

M.R.

November 10, 2013

Hi Lee, I've tried to implement your method for drawing star - it's also your code, but with implemented your method you showed here on rectangle... I have an issue : snap marker isn't showing probably due to usage of (grvecs) twicely - one for correct dynamic effect of star and the other for snap marker... So can you fix this or it couldn't be fixed???

Marko,

Excluding the Object Snap modifications taken from my rectangle program, you appear to be using code that has been modified from my original 'Star' program - namely, my original code does not include the expressions (vl-cmdf "_.ucs" "m" p) and (vl-cmdf "_.ucs" "p").

The attached program implements the Object Snap code from my 3-Point Rectangle program into my Star program, and appears to perform correctly under all UCS & View settings, as demonstrated by the following animation:

StarV1-1.lsp

November 10, 2013

Yes, I figured this one... It was (redraw) and correct order of functions issue... It works now :

;; Star  -  Lee Mac - [b]Modifications made by Marko Ribar[/b]
(defun c:star ( / *error* _points gr a g l m n p q r x z )

   (defun *error* ( m ) (redraw) (princ))
 
   (defun _points ( n m / a i l r )
       (setq i (/ (+ pi pi) n)
             a 0.0
             r 1.0
       )
       (repeat n
           (setq l (cons (polar '(0.0 0.0) a r) l)
                 a (+ a i)
                 r (- m r)
           )
       )
       l
   )
   
   (if (setq p (getpoint "\nPick Center: "))
       (progn
           (if (zerop (logand 16384 (getvar 'osmode)))
               (eval
                   (list 'defun 'snap '( e / f )
                       (list 'if (list 'setq 'f (list 'osnap 'e (LM:getosmode (getvar 'osmode))))
                           (list 'LM:grX 'f (atoi (getenv "AutoSnapSize"))
                               (LM:OLE->ACI
                                   (if (= 1 (getvar 'cvport))
                                       (atoi (getenv "Layout AutoSnap Color"))
                                       (atoi (getenv "Model AutoSnap Color"))
                                   )
                              )
                           )
                          '(setq f e)
                       )
                       'f
                   )
               )
               (defun snap ( e ) e)
           )
           (vl-cmdf "_.ucs" "m" p)
           (setq p '(0.0 0.0 0.0))
           (setq n 10
                 m 1.3
                 z (trp (mapcar '(lambda ( x ) (trans x 1 2 t)) '((1.0 0.0) (0.0 1.0) (0.0 0.0))))
                 l (_points n m)
           )
           (princ "\nPick Radius [ +/- / </> ] <Exit>: ")
           (while
               (progn
                   (setq g (car (setq gr (grread t 15 0))))
                   (redraw)
                   (cond
                       (   (or (= 3 g) (= 5 g))
                           (setq q (if (listp (cadr gr)) (snap (cadr gr)) (cadr gr)))
                           (if (< 0 (setq r (distance p q)))
                               (progn
                                   (setq a (angle p q))
                                   (grvecs (cons -1 (apply 'append (mapcar 'list l (cons (last l) l))))
                                       (append
                                           (mapcar 'append
                                               (mxm z
                                                   (list
                                                       (list (* r (cos a)) (* r (sin (- a))) 0.0)
                                                       (list (* r (sin a)) (* r (cos a))     0.0)
                                                      '(0.0 0.0 1.0)
                                                   )
                                               )
                                               (mapcar 'list (trans p 1 2))
                                           )
                                          '((0.0 0.0 0.0 1.0))
                                       )
                                   )
                               )
                           )
                           (= 5 g)
                       )
                       (   (= 2 g)
                           (setq q (if (listp (cadr gr)) (snap (cadr gr)) (cadr gr)))
                           (cond
                               (   (member q '(45 95))
                                   (if (< 7 n)
                                       (setq n (- n 2)
                                             l (_points n m)
                                       )
                                       (princ "\nMinimum reached.")
                                   )
                               )
                               (   (member q '(43 61))
                                   (setq n (+ 2 n)
                                         l (_points n m)
                                   )
                               )
                               (   (member q '(44 60))
                                   (if (< 1.0 m)
                                       (setq m (- m 0.1)
                                             l (_points n m)
                                       )
                                       (princ "\nMinimum reached.")
                                   )
                               )
                               (   (member q '(46 62))
                                   (setq m (+ m 0.1)
                                         l (_points n m)
                                   )
                               )
                           )
                       )
                   )
               )
           )
           (if (= 3 g)
               (progn
                   (setq a (angle p q)
                         z (trans '(0.0 0.0 1.0) 1 0 t)
                         a (list (list (* r (cos a)) (* r (sin (- a)))) (list (* r (sin a)) (* r (cos a))))
                   )
                   (entmake
                       (append
                           (list
                              '(000 . "LWPOLYLINE")
                              '(100 . "AcDbEntity")
                              '(100 . "AcDbPolyline")
                               (cons 90 n)
                              '(070 . 1)
                               (cons 38 (- (caddr (trans p 0 1))))
                           )
                           (mapcar '(lambda ( x ) (cons 10 (trans (mapcar '+ (mxv a x) p) 1 z))) l)
                           (list (cons 210 z))
                       )
                   )
                   (vl-cmdf "_.ucs" "p")
               )
           )
           (redraw)
       )
   )
   (princ)
)

;; Matrix Transpose  -  Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
   (apply 'mapcar (cons 'list m))
)

;; Matrix x Matrix  -  Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
   ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Get Object Snap String  -  Lee Mac
;; Returns a comma-delimited string of active Object Snap modes
;; os - [int] OSMODE bit-coded integer

(defun LM:getosmode ( os / lst )
   (foreach mode
      '(
           (0001 . "_end")
           (0002 . "_mid")
           (0004 . "_cen")
           (0008 . "_nod")
           (0016 . "_qua")
           (0032 . "_int")
           (0064 . "_ins")
           (0128 . "_per")
           (0256 . "_tan")
           (0512 . "_nea")
           (1024 . "_qui")
           (2048 . "_app")
           (4096 . "_ext")
           (8192 . "_par")
       )
       (if (not (zerop (logand (car mode) os)))
           (setq lst (cons "," (cons (cdr mode) lst)))
       )
   )
   (apply 'strcat (cdr lst))
)

;; GrX  -  Lee Mac
;; Displays an 'X' at the supplied point.
;; p - [lst] UCS point for symbol
;; s - [int] Size of symbol in pixels
;; c - [int] ACI colour of symbol

(defun LM:grX ( p s c / -s r j )
   (setq -s (- s)
          r (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
          j (trans p 1 3)
   )
   (grvecs
       (list c
           (list -s      -s)  (list s       s)
           (list -s  (1+ -s)) (list (1- s)  s)
           (list (1+ -s) -s)  (list s   (1- s))
           
           (list -s       s)  (list s      -s)
           (list -s   (1- s)) (list (1- s) -s)
           (list (1+ -s)  s)  (list s  (1+ -s))
       )
       (list
           (list r  0. 0. (car  j))
           (list 0. r  0. (cadr j))
           (list 0. 0. r  0.)
           (list 0. 0. 0. 1.)
       )
   )
   p
)

;; 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 )
)

;; 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)

Thanks, Lee...

Edited November 10, 2013 by marko_ribar
added titled description that original code was modified...

November 10, 2013

The code you have posted does not attempt to snap the final clicked point, and also contains unnecessary modifications to my original program [ (vl-cmdf "_.ucs" "m" p) and (vl-cmdf "_.ucs" "p") ]; I would appreciate if you would either mark the modifications you have made to my original code, or remove the code.

November 10, 2013

I've marked the title of the code...

And as final point click, there is no need to snap to q variable again that already contains snapped coordinates of tracked point by (grread)... Test it - it'll snap correctly...

M.R.

Sign In

Rectangle lisp.Little help !

Recommended Posts

Guest

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Lee Mac

GP_

Guest

Lee Mac

Guest

lrm

pBe

GP_

Lee Mac

fixo

marko_ribar

marko_ribar

Lee Mac

marko_ribar

Lee Mac

marko_ribar

Join the conversation

Tutorials

Forums

Activity