Transparent Lisp Command (OSNAP)

[Joe LeBaron]

I am trying to make my own "osnap" that will snap to the middle of two
points selected.

Looks like this:
(defun emidp ()
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\nSelect First Point: "))
(setq p2 (getpoint "\nSelect Second Point: "))
(setq emidp (list (/ (+ (car p1) (car p2)) 2.0) (/ (+ (cadr p1) (cadr p2))
2)))
(setvar "osmode" osm)
)

This works if I am within one of the Autocad standard commands, but if I am
within an AutoLisp progroam at a (getpoint) prompt, it says cannot re-enter
AutoLisp.

Is there a way to make this truly transparent (like the regular osnaps). I
have played with:
(vlax-add-cmd "emidp" 'emidp)
but this does not:
(1) run transparently
(2) return a point as a value

Any help or examples (or kick in the butt if I am barking up the wrong tree)
is appreciated.

Joe LeBaron

[Paul D]

I've been using this for awhile with no problems, I believe this works in 2k
or higher
routine complements of Mr. Puckett

(defun c:midpt ( / p p1 p2 )
; test for valid point entry
(if (setq p1 (getpoint "First point: "))
(if (setq p2 (getpoint p1 "Second point: "))
(progn
(setq p (mapcar '(lambda (x) (/ x 2.0)) (mapcar '+ p1 p2)))
(if (< 0 (getvar "cmdactive"))
(if (< 0 (getvar "osmode"))
(command "_none" p)
(command p)
)
p
)
)
)
)
(princ)
)
Joe LeBaron <j...@jlebaron.com> wrote in message
news:76A0A3E1F70507F5...@in.WebX.maYIadrTaRb...

[Joe Burke]

Joe LeBaron,

One way to do it, though not necessarily the best. Within your other program
the emidp function can be called like this: (c:emidp)

Example:
(defun C:drawline ()
(command "line" pause pause "") ; draw first line
(command "line" (c:emidp) pause pause "") ; second line
)

The emidp function is called. Second line starts at the midpoint of the
first if you pick the two endpoints of first line. This assumes emidp is
loaded and available.

Think you also need to change the first line of emidp to this: (defun C:
emidp (). Add the C:

HTH
Joe Burke

"Joe LeBaron" <j...@jlebaron.com> wrote in message
news:76A0A3E1F70507F5...@in.WebX.maYIadrTaRb...

[Joe Burke]

Joe LeBaron,

Upon further reflection, what I suggested probably won't work given your
emidp routine. The last value it returns is that of (setvar "osmode" osm),
not the point calculated. So you would have to remove that line of code from
emidp to return a point to other lisp programs that call it.

That sort of thing is part of the reason why I mentioned doing it this way
is not ideal. A midpoint function that works within common commands, is not
necessarily suited for use within lisp programs. You'd be better off
incorporating the midpoint routine into the programs where you need it.

I'm new at this stuff. The experts may correct me. More than welcome...

Joe Burke

[Joe LeBaron]

Thanks for the suggestions!!!
Paul,
The program you listed does the same thing as the one I posted (although
with better error checking). The problem is that I cannot call it from the
command line when another lisp program is active. If you type at the
command line (setq a (getpoint)) and the try to use 'midpt it says you
cannot reenter AutoLisp.

Joe,
I am trying to make somethng than any user can use from within any command
(like an osnap). I don't know when programming if they are going to want to
use Endpoint, Center, or EmidPt.

Thanks for all the help so far (this forum is GREAT). I hope this clarifies
what I am trying to do.

Joe LeBaron

"Joe LeBaron" <j...@jlebaron.com> wrote in message
news:76A0A3E1F70507F5...@in.WebX.maYIadrTaRb...

[Joe LeBaron]

I found the solution - I have to admit that I found it in archive of this
newsgroup at:
http://xarch.tu-graz.ac.at/autocad/news/autodesk.autocad.customization/msg00
270.html

Thanks to Steve Adams

The final code looks like:
(vl-load-com)
(defun emidp ()
(setq activedoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq a (getpoint "\nSelect First Point: "))
(setq b (getpoint a "\nSelect Second Point: "))
(setq c (list (/ (+ (car a) (car b)) 2.0) (/ (+ (cadr a) (cadr b)) 2)))
(setvar "osmode" os)
(setq cstring (strcat (rtos (car c) 2 8) "," (rtos (cadr c) 2 8) "\n"))
(vla-SendCommand activedoc cstring)
)
(vlax-add-cmd "emidpX" 'emidp "emidpX" ACRX_CMD_TRANSPARENT)

At any getpoint prompt I can just type in 'emidpx (I have it on an
accelerator key) and it works GREAT.

Thanks to everyone for all your help

"Joe LeBaron" <j...@jlebaron.com> wrote in message
news:76A0A3E1F70507F5...@in.WebX.maYIadrTaRb...

[Joe LeBaron]

Oops! I pasted Steve's code and then referenced mine (I apologize for the
multiple posts - is anyone still reading???)
Mine looks like:

(vl-load-com)
(defun emidp ()
(setq activedoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq a (getpoint "\nSelect First Point: "))
(setq b (getpoint a "\nSelect Second Point: "))
(setq c (list (/ (+ (car a) (car b)) 2.0) (/ (+ (cadr a) (cadr b)) 2)))
(setvar "osmode" os)
(setq cstring (strcat (rtos (car c) 2 8) "," (rtos (cadr c) 2 8) "\n"))
(vla-SendCommand activedoc cstring)

)
(vlax-remove-cmd "emidpx")

(vlax-add-cmd "emidpX" 'emidp "emidpX" ACRX_CMD_TRANSPARENT)

Notice the vlax-remove-cmd. This removes the command emidpx if it exists
(returns 1) and returns 0 if it doesn't.
I am running Acad2002 in an SDI enviornment with a reload of acad.lsp with
every new drawing. When I would open a new draiwng from the Acad interface
the duplicate definition of midpx "breaks" the midpx command - hence the
remove and then add.

"Joe LeBaron" <j...@jlebaron.com> wrote in message

news:C79A5A0327ACF579...@in.WebX.maYIadrTaRb...

[Joe Burke]

Works nice, Joe. Thanks for posting it.

Joe Burke

[Marc'Antonio Alessi]

I think that another way to have a transparent function
(for r<15) is to use initget 128 before getpoint.

Marco

"Joe LeBaron" <j...@jlebaron.com> ha scritto nel messaggio
news:76A0A3E1F70507F5...@in.WebX.maYIadrTaRb...

[Joe LeBaron]

Initget does not affect the transparency of the command. It justs sets
acceptable responsed to a getxxx function. You still get the message
"cannot reenter AutoLisp" if you try to use it.

As a test, try this:
At the command prompt: (getpoint)
Now try typing !a or (emidp) (or any other lisp function).
You get the "Cannot Reenter AutoLisp"

If you type:
Line
and then type !a or (emidp) (assuming a is a point and (emidp) is my defined
function0, it works.

Also If you type:
(getpoint)
Mid
You are now prompted for a midpoint and that midpoint will be returned by
the function (getpoint)

This is the "transparency" I was looking for. The ability to define a
function that is globally transparent (on of these days I have to sit down
with the ObjectARX book).

Hope this helps

"Marc'Antonio Alessi" <nospam....@tin.it> wrote in message
news:CFD392E911A98035...@in.WebX.maYIadrTaRb...

> I think that another way to have a transparent function
> (for r<15) is to use initget 128 before getpoint.
>
> Marco
>

<..SNIP...>

[Marc'Antonio Alessi]

I wrote this many years ago, when initget bit 128 was introduced.
You can nest more than one function using upoint rather than getpoint.
The transparent functions can be nested in a command or upoint response
in any sequence and number.
I do not remember why I used (ALONG """""""ACTIVE""""""") with many "
but I still use these functions in all my routines, maybe now if I have
time I want to revise something.

; from Inside Autolisp - New Riders Publishing (modified)

;* UPOINT Funzione di interfaccia utente per punti.
;* BIT (1 per non nullo, 0 per nessuno) e KWD key word ("" per nessuna) sono
;* gli stessi di INITGET.
;* MSG e' la stringa di prompt alla quale e' aggiunta una variabile di punto
di
;* default come <DEF> (nil per nessuna), e un : sara' aggiunto.
;* BPT e' il punto base (nil per nessuno).
;*

(defun upoint (bit kwd msg def bpt / inp pts ptZ)
(if def
(setq
ptZ (caddr def)
pts (strcat (rtos (car def)) "," (rtos (cadr def)) "," (if ptZ (rtos
ptZ) "0"))
msg (strcat "\n" msg " <" pts ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(setq inp "STRINGANONVALIDA" bit (+ bit 128))
(while
(not
(or
(= 'LIST (type inp))
(null inp)
(if (= 'STR (type inp)) (or (= 'LIST (type (read inp))) (wcmatch kwd
(strcat "*" inp "*"))))
) )
(initget bit kwd)
(setq inp (if bpt (getpoint msg bpt) (getpoint msg)))
)
(if inp
(if (or (/= 'STR (type inp)) (atom (read inp)))
inp
(eval (if (= "ACTIVE" (cadr (read inp))) (subst nil "ACTIVE" (read
inp)) (read inp)))
)
def
)
);defun UPOINT

(defun MEDIO (cmdact / pts pt2 cblip corto)
(graphscr)
(setq cblip (getvar "BLIPMODE") corto (getvar "ORTHOMODE"))
(setvar "BLIPMODE" 1) (setvar "ORTHOMODE" 0)
(setq
pts (upoint 40 "" ">>Primo punto <Lastpoint>" (getvar "LASTPOINT")
(getvar "LASTPOINT"))
pt2 (upoint 41 "" ">>Secondo punto" nil pts)
)
(setq pts (polar pts (angle pts pt2) (/ (distance pts pt2) 2.0)))
(setvar "BLIPMODE" cblip) (setvar "ORTHOMODE" corto)
(cond ((and pts cmdact) (command "_NONE" pts))
(pts)
(T (ai_alert "Punto medio non trovato.") (princ))
)
)

(defun ALONG (cmdact / pts e1 ende1 corto cosnp)
(graphscr)
(setq corto (getvar "ORTHOMODE") cosnp (getvar "OSMODE"))
(setvar "ORTHOMODE" 0) (setvar "OSMODE" 0)
(while (not e1)
(setq e1 (entsel "\n>>Tocca vicino all'estremo su cui calcolare la
distanza: "))
(if e1
(if (setq ende1 (osnap (cadr e1) "_END"))
nil
(progn
(ai_alert "Entita' non coerente con la funzione.")
(setq e1 nil)
) ) )
)
(setq #mdist (udist 46 "" ">>Distanza dal punto finale" #mdist ende1)
pts (polar ende1 (angle ende1 (osnap (cadr e1) "_MID")) #mdist)
)
(setvar "ORTHOMODE" corto) (setvar "OSMODE" cosnp)
(cond ((and pts cmdact) (command "_NONE" pts) (princ))
(pts)
(T (ai_alert "Punto non trovato.") (princ))
)
)

(defun BISETTR (cmdact / pts corm)
(graphscr)
(setq corm (getvar "ORTHOMODE")) (setvar "ORTHOMODE" 0)
(setq pts (upoint 40 "" ">>Vertice dell'angolo <Lastpoint>" (getvar
"LASTPOINT") (getvar "LASTPOINT")))
(setq
#rel1 (udist 46 "" ">>Distanza dal vertice" #rel1 pts)
#ang1 (uangle 40 "" ">>Primo angolo di riferimento" #ang1 pts)
#ang2 (uangle 40 "" ">>Secondo angolo di riferimento" #ang2 pts)
)
(if (< #ang1 #ang2)
(progn
(grdraw pts (polar pts (+ #ang1 (/ (- #ang2 #ang1) 2.00)) #rel1) -1 1)
(setq pts (polar pts (+ #ang1 (/ (- #ang2 #ang1) 2.00)) #rel1))
)
(progn
(grdraw pts (polar pts (+ #ang1 (gar 180.0)(/ (- #ang2 #ang1) 2.00))
#rel1) -1 1)
(setq pts (polar pts (+ #ang1 (gar 180.0)(/ (- #ang2 #ang1) 2.00))
#rel1))
)
)
(setvar "ORTHOMODE" corm)
(cond ((and pts cmdact) (command "_NONE" pts) (princ))
(pts)
(T (ai_alert "Punto non trovato.") (princ))
)
);defun

(defun DISTPR (cmdact / pts pt2 inc corto cblip)
(graphscr)
(setq corto (getvar "ORTHOMODE") cblip (getvar "BLIPMODE" ))
(setvar "ORTHOMODE" 1) (setvar "BLIPMODE" 1)
(setq inc 0)
(setq pts (upoint -88 "" ">>Punto di riferimento <Lastpoint>" (getvar
"LASTPOINT") nil))
(while (setq pt2 (upoint -88 "" ">><Punto successivo>/Return per
terminare" nil pts))
(setq inc (+ inc (distance pts pt2)))
(prompt
(strcat "\n>>Distanza: " (rtos (distance pts pt2)) " Angolo: "
(angtos (angle pts pt2))
" Distanza totale: " (rtos inc) "\n "
)
)
(grdraw pts pt2 -1 1) (setq pts pt2)
)
(setvar "ORTHOMODE" corto) (setvar "BLIPMODE" cblip)
(cond ((and pts cmdact) (command "_NONE" pts) (princ))
(pts)
(T (ai_alert "Punto non trovato.") (princ))
)
);defun C:DISTPR

this is the macro for menu:

^P$M=$(if,$(getvar,cmdactive),(ALONG """""""ACTIVE"""""""),(ALONG nil));
^P$M=$(if,$(getvar,cmdactive),(MEDIO """""""ACTIVE"""""""),(MEDIO nil));
^P$M=$(if,$(getvar,cmdactive),(BISETTR """""""ACTIVE"""""""),(BISETTR nil));
^P$M=$(if,$(getvar,cmdactive),(DISTPR """""""ACTIVE"""""""),(DISTPR nil));

"Joe LeBaron" <j...@jlebaron.com> ha scritto nel messaggio

news:7674FE223BECAFA6...@in.WebX.maYIadrTaRb...

[P.C.]

Hi.

Marc'Antonio Alessi skrev i meddelelsen

> (cond ((and pts cmdact) (command "_NONE" pts) (princ))
> (pts)
> (T (ai_alert "Punto non trovato.") (princ))

Nice piece of Lisp code ; cond, strcat, rtos --- all the good old ones.
I reached tree line stuff and hit recurtion loft to with AutoLisp ;))
Looking at old code realy make you wonder. Guess how much good Lisp stuff is
out there ,not repeatly command but Lisp when it make sense:))
Have a nice day.
P.C.
http://w1.1396.telia.com/~u139600113/

[Joseph Charpentier]

the multiple quotes are required if you call some commands from a menu with
diesel-Each time diesel parses a string, it strips a quote set from it. I
found that out the hard way- I didn't scrutinize your code to find out if
all the quotes are actually required or not...

Joe

"Marc'Antonio Alessi" <nospam....@tin.it> wrote in message

news:797896E51E9C9799...@in.WebX.maYIadrTaRb...

[Marc'Antonio Alessi]

Thanks P. C. and Joe,

Do you have tried about nesting?

example:

I need to draw a circle in a point that
is in the middle point between two relative points

Comando: _CIRCLE 3P/2P/TTR/<Centro>: [use the below macro]
^P$M=$(if,$(getvar,cmdactive),(MEDIO """""""ACTIVE"""""""),(MEDIO nil));

>>Primo punto <Lastpoint> <25,65,0>:[use the below macro]
^P$M=$(if,$(getvar,cmdactive),(RELTR1 """""""ACTIVE"""""""),(RELTR1 nil));

>>Relativo a <Lastpoint> <25,65,0>: 10,10
>><Distanza relativa>/Doppia <90>: 20
>>Angolo relativo <90>: 0

>>Secondo punto:>:[use the below macro]
^P$M=$(if,$(getvar,cmdactive),(RELTR1 """""""ACTIVE"""""""),(RELTR1 nil));

>>Relativo a <Lastpoint> <25,65,0>: 100,100
>><Distanza relativa>/Doppia <20>: 30
>>Angolo relativo <0>: 90

_NONE Diametro/<Raggio> <210.49>: [draw the circle]

Load the below code:

;(maybe there is something to rewrite but works in A2ki or lower)

;* from Inside Autolisp - New Riders Publishing (modified)

(defun RELTR1 (cmdact / pts corm cipm msg)
(graphscr)
(if (= 1 (getvar "SNAPSTYL"))
(progn
(setq cipm (getvar "SNAPISOPAIR") corm (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
)
)
(setq pts (upoint 40 "" ">>Relativo a <Lastpoint>" (getvar "LASTPOINT")
(getvar "LASTPOINT")))
(if (= "Doppia" (setq msg (udist 44 "Doppia" ">><Distanza
relativa>/Doppia" #rel1 pts)))
(setq #rel1 (/ (udist 46 "" ">>Distanza doppia" #rel1 pts) 2.0))
(setq #rel1 msg)
)
(setq #ang1 (uangle 40 "" ">>Angolo relativo" #ang1 pts))
(if (= 1 (getvar "SNAPSTYL"))
(progn
(setq #ang1 (ISORTOSN #ang1))
(setvar "ORTHOMODE" corm) (setvar "SNAPISOPAIR" cipm)
)
)
(grdraw pts (polar pts #ang1 #rel1) -1 1)
(setq pts (polar pts #ang1 #rel1))

(cond ((and pts cmdact) (command "_NONE" pts) (princ))
(pts)
(T (ai_alert "Punto non trovato.") (princ))
)
);defun

(defun RELTR2 (cmdact / pts cosm corm cipm)
(graphscr)
(if (= 1 (getvar "SNAPSTYL"))
(progn
(setq cipm (getvar "SNAPISOPAIR") corm (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 0)
)
)
(setq pts (upoint 40 "" ">>Relativo a <Lastpoint>" (getvar "LASTPOINT")
(getvar "LASTPOINT")) )
(setq cosm (getvar "OSMODE")) (setvar "OSMODE" 0)
(setq #rel1 (udist 44 "" ">>Prima distanza relativa" #rel1 pts))
(setq #ang1 (uangle 40 "" ">>Primo angolo" #ang1 pts))
(if (= 1 (getvar "SNAPSTYL"))
(progn (setq #ang1 (ISORTOSN #ang1)) (setvar "SNAPISOPAIR" cipm))
(if (= 0 (getvar "ORTHOMODE")) (setq #ang1 (STORTOSN #ang1)))
)
(grdraw pts (polar pts #ang1 #rel1) -1 1)
(setq pts (polar pts #ang1 #rel1))
(if (= "Prima" (setq #rel2 (udist 44 "Prima" ">><Seconda distanza
relativa>/Prima" #rel2 pts)))
(setq #rel2 #rel1)
)
(setq #ang2 (uangle 40 "" ">>Secondo angolo" #ang2 pts))
(if (= 1 (getvar "SNAPSTYL"))
(progn (setq #ang2 (ISORTOSN #ang2)) (setvar "SNAPISOPAIR" cipm) (setvar
"ORTHOMODE" corm))
(if (= 0 (getvar "ORTHOMODE")) (setq #ang2 (STORTOSN #ang2)))
)
(grdraw pts (polar pts #ang2 #rel2) -1 1)
(setq pts (polar pts #ang2 #rel2))
(setvar "OSMODE" cosm)

(cond ((and pts cmdact) (command "_NONE" pts) (princ))
(pts)
(T (ai_alert "Punto non trovato.") (princ))
)
)

(defun int (cmdact / pts e1 e2 ende1 ende2 mide1 mide2 cosnp)
(graphscr)
(setq cosnp (getvar "OSMODE")) (setvar "OSMODE" 0)
(while (not e1) (setq e1 (entsel "\n>>Selezionare il primo segmento verso
l'intersezione: ")))
(while (not e2) (setq e2 (entsel "\n>>Selezionare il secondo segmento
verso l'intersezione: ")))
(setq ende1 (osnap (cadr e1) "_end") mide1 (osnap (cadr e1) "_mid")
ende2 (osnap (cadr e2) "_end") mide2 (osnap (cadr e2) "_mid")
pts (inters ende1 mide1 ende2 mide2 nil)
)

(setvar "OSMODE" cosnp)
(cond ((and pts cmdact) (command "_NONE" pts) (princ))
(pts)

(T (ai_alert "Intersezione non trovata.") (princ))
)
)

;* from Inside Autolisp - New Riders Publishing (modified)
;* UDIST Funzione di interfaccia utente per distanze.
;* BIT (0 per nessuno) e KWD key word ("" per nessuna) sono gli stessi di
;* INITGET.
;* MSG e' la stringa di prompt, alla quale e' aggiunto numero reale di
default
;* come <DEF> (nil per nessuno), e un : sara' aggiunto.

;* BPT e' il punto base (nil per nessuno).
;*

(defun udist (bit kwd msg def bpt / inp)
(if def
(setq
msg (strcat "\n" msg " <" (ALE_RTOS_DZ8 def) ">: ")

bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))

);if
(initget bit kwd)
(setq inp (if bpt (getdist msg bpt) (getdist msg)));setq&if
(if inp inp def)
);defun UDIST

;*
;* UANGLE Funzione di interfaccia utente per angoli.

;* BIT (1 per non nullo, 0 per nessuno) e KWD key word ("" per nessuna) sono
;* gli stessi di INITGET.

;* MSG e' la stringa di prompt, alla quale e' aggiunto un numero reale in
;* radianti di default come <DEF> (nil per nessuno), e un : sara' aggiunto.

;* BPT e' il punto base (nil per nessuno).
;*

(defun uangle (bit kwd msg def bpt / inp)
(if def
(setq
msg (strcat "\n" msg " <" (angtos def) ">: ")

bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)

(initget bit kwd)
(setq inp (if bpt (getangle msg bpt) (getangle msg)))
(if inp inp def)
);defun UANGLE

(defun ISORTOSN (ang)
(cond
( (>= 60.0 (rag ang) 0.0) (setvar "SNAPISOPAIR" 0) (gar 30.0))
( (>= 120.0 (rag ang) 60.0) (setvar "SNAPISOPAIR" 1) (gar 90.0))
( (>= 180.0 (rag ang) 120.0) (setvar "SNAPISOPAIR" 2) (gar 150.0))
( (or (>= 240.0 (rag ang) 180.0) (>= -120.0 (rag ang) -180.0))
(setvar "SNAPISOPAIR" 0) (gar 210.0)
)
( (or (>= 300.0 (rag ang) 240.0) (>= -60.0 (rag ang) -120.0))
(setvar "SNAPISOPAIR" 1) (gar 270.0)
)
( (or (>= 360.0 (rag ang) 300.0) (>= -1.0 (rag ang) -60.0))
(setvar "SNAPISOPAIR" 2) (gar 330.0)
)
(T (ai_alert "L'orto automatico ha avuto esito negativo."))
);cond
);defun
;*
(defun STORTOSN (ang)
(cond
( (or (>= 135.0 (rag ang) 45.0) (>= -225.0 (rag ang) -315.0)) (gar
90.0))
( (or (>= 225.0 (rag ang) 135.0) (>= -135.0 (rag ang) -225.0)) (gar
180.0))
( (or (>= 315.0 (rag ang) 225.0) (>= -45.0 (rag ang) -135.0)) (gar
270.0))
( (or (>= 45.0 (rag ang) 0.0) (>= 360.0 (rag ang) 315.0)
(>= -315.0 (rag ang) -360.0) (>= -0 (rag ang) -45.0)
)
(gar 0.0)
)
(T (ai_alert "L'orto automatico ha avuto esito negativo."))
);cond
);defun
;*
(defun ALE_RTOS_DZ8 (real_val / old_dimzin new_val)
(setq old_dimzin (getvar "DIMZIN")) (setvar "DIMZIN" 8)
(setq new_val (rtos real_val 2)) (setvar "DIMZIN" old_dimzin)
new_val
)
(defun GAR (a) (* pi (/ a 180.0)))
(defun RAG (a) (/ (* a 180.0) pi))
(princ)
;END

;macros:

;^P$M=$(if,$(getvar,cmdactive),(RELTR1 """""""ACTIVE"""""""),(RELTR1 nil));
;^P$M=$(if,$(getvar,cmdactive),(RELTR2 """""""ACTIVE"""""""),(RELTR2 nil));
;^P$M=$(if,$(getvar,cmdactive),(ALONG """""""ACTIVE"""""""),(ALONG nil));
;^P$M=$(if,$(getvar,cmdactive),(INT """""""ACTIVE"""""""),(INT nil));

;^P$M=$(if,$(getvar,cmdactive),(MEDIO """""""ACTIVE"""""""),(MEDIO nil));
;^P$M=$(if,$(getvar,cmdactive),(BISETTR """""""ACTIVE"""""""),(BISETTR
nil));

; example of a lisp routine that use upoint
; triangle tree sides length

(defun C:ZTRELATI (/ pt1 pt2 lt2 lt3 sper tng)
; (MODESET '("SNAPSTYL" "OSMODE"))
; (if #mdauto (MODELYR "SET" #grp #lyrd #mlcd #mlld #mcld #mltd 0))
(setvar "SNAPSTYL" 0)
(setq
pt1 (upoint 40 "" "Primo punto del primo lato <Lastpoint>" (getvar

"LASTPOINT") (getvar "LASTPOINT"))

)
(setvar "OSMODE" 0)
(setq #mdist (udist 46 "" "Lunghezza del primo lato" #mdist pt1))
(setq #ang (uangle 40 "" "Angolo del primo lato" #ang pt1))
(setq pt2 (polar pt1 #ang #mdist))
(grdraw pt1 pt2 -1 1)
(setq lt2 (udist 46 "" "Lunghezza del secondo lato" #mdist pt1))
(while (not (and (< lt3 (+ #mdist lt2 )) (> lt3 (abs (- #mdist lt2)))))
(initget (+ 2 8 32))
(setq lt3 (udist 46 "" "Lunghezza del terzo lato" lt2 pt2))
(if (or (> lt3 (+ #mdist lt2 )) (< lt3 (abs (- #mdist lt2))))
(ai_alert "Non esiste un triangolo con questo lato.")
)
)
(setq
sper (/ (+ lt3 #mdist lt2) 2.0)
tng (sqrt(/ (* (- sper #mdist ) (- sper lt2)) (* sper (- sper lt3))))
)
(command "_.PLINE" pt1 pt2 (polar pt1 (+ #ang (* 2.0 (atan tng))) lt2)
"_C")
; (MODERESET)
(princ)
)