vlax-add-cmd ... return point as transparent cmd?

Is it possible to define a lisp routine that can be used transparently in
response to any getpoint request, whether from a built-in command or lisp
routine? For example the following works just fine transparently for
built-in commands, but I can't use it to respond to my lisp routines.

(defun c:Between (/ reset pt)
(setq reset (boole 2 (getvar "autosnap") 24)
reset (cons '("orthomode" "autosnap") (list 0 reset))
reset (list (car reset) (mapcar 'getvar (car reset)) (cdr reset))
pt (mapcar '(lambda (a b) (/ (+ a b) 2))
(getpoint "\nPick first point for \"Between\"... ")
(getpoint "\nPick last point for \"Between\"... ")
)
)
(mapcar 'setvar (car reset) (caddr reset))
(command pt)
(mapcar 'setvar (car reset) (cadr reset))
(princ)
)

And if I follow the suggestion to strip the c: and use vlax-add-cmd on it,
it doesn't return a point at all.
(vlax-add-cmd "Between" 'Between nil 5)

Besides, I noticed the following line in the help for vlax-add-cmd.
Warning! You cannot use the command function call in a transparently-defined
vlax-add-cmd function. Doing so can cause AutoCAD to close unexpectedly.

I've seen many similar threads and thought I had seen that this was
possible, but I sure can't seem to find it or figure it out.

 

If the command is transparent, you can't call (command).

The only possible way to do it would be with vla-SendCommand.

 

Hi James,

Here's something I saved from the NG a couple years ago. Might help.

It's not mine and I've lost track of who wrote it.

Joe Burke

(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.0)))
(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.
;;;;;;;;;;;
;in other words most folks wouldn't need those two lines

 

Huh! Well that was easy. Now I wonder why send-command would be okay but
not command or vl-cmdf? I figured these were all accessing the same stuff
'under the hood'. Maybe not. Being a perfectionist I also wonder about
loss of precision by processing the point as a string, but 8 digits will
probably do. Anyway, here's what I am going to try.

(defun Between (/ doc reset pt)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
reset (boole 2 (getvar "autosnap") 24)
reset (cons '("orthomode" "autosnap") (list 0 reset))
reset (list (car reset) (mapcar 'getvar (car reset)) (cdr reset))
pt (mapcar '(lambda (a b) (/ (+ a b) 2))
(getpoint "\nPick first point for \"Between\"... ")
(getpoint "\nPick last point for \"Between\"... ")
)
pt (mapcar '(lambda (a) (strcat "," (rtos a 2 8))) pt)
pt (substr (apply 'strcat pt) 2)
)
(mapcar 'setvar (car reset) (caddr reset))
(vla-SendCommand doc (strcat pt "\n"))
(mapcar 'setvar (car reset) (cadr reset))
(princ)
)

(vlax-add-cmd "Between" 'Between nil 1)

Thank you Joe.

James

 

To avoid loss of precision, assign the value to a symbol:

(setq MyPoint '(2.0 4.0 0.0))

Then, use vla-sendcommand to pass the symbol
prefixed with ! :

(vla-SendCommand <Document> "!MyPoint")

 

Tony you are the best !

 

James,

My pleasure. I was lucky to find it.

And thanks to Tony for his insights.

Joe

 

Excellent!

Thank you, Tony.

James

 

Actually, on further evaluation, that put me back at square one. It works
fine for a built-in command, but throws the "Can't re-enter lisp" error for
a getpoint request from lisp. Guess I'll go back to the string method...

Tony, is the fact that SendCommand requires all of the prompts to be wrapped
up in a single string a clue to the difference between it and
command/vl-cmdf? I seem to remember someone suggesting that SendCommand is
okay in a reactor though command is not. The help files plainly contradict
that idea, but the vlax-add-cmd help doesn't directly address vl-cmdf or
SendCommand. Not knowing the inner workings as well, I still wonder if that
help warning applies to SendCommand as well.

James

 

Is it possible to define a lisp routine that can be used transparently in

<clip>


Da:Marc'Antonio Alessi
Soggetto:R: Transparent Lisp Command (OSNAP)
Newsgroups:autodesk.autocad.customization
Data:2001-09-03 14:40:11 PST

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)

;* BIT (1 no null, 0 no one) e KWD key word ("" no one) see INITGET
;* MSG prompt string with default <DEF> added (nil no one),
;* ":" will be added
;* BPT base point (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 "NOTVALIDSTRING" 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 MEDIO (cmdact / pts pt2 cblip corto)
(graphscr)
(setq cblip (getvar "BLIPMODE") corto (getvar "ORTHOMODE"))
(setvar "BLIPMODE" 1) (setvar "ORTHOMODE" 0)
(setq
pts (upoint
40 "" ">>First point <Lastpoint>"
(getvar "LASTPOINT") (getvar "LASTPOINT")
)
pt2 (upoint 41 "" ">>Second point" 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 "Mid point not found.") (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>>Pick near an endpoint: "))
(if e1
(if (setq ende1 (osnap (cadr e1) "_END"))
nil
(progn
(ai_alert "Entity not valid for the function.")
(setq e1 nil)
) ) )
)
(setq
#mdist (udist 46 "" ">>Distance from endpoint" #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 "Point not found.") (princ) )
)
)
;
(defun BISETTR (cmdact / pts corm)
(graphscr)
(setq corm (getvar "ORTHOMODE")) (setvar "ORTHOMODE" 0)
(setq
pts (upoint
40 "" ">>Angle vertex <Lastpoint>"
(getvar "LASTPOINT") (getvar "LASTPOINT")
)
#rel1 (udist 46 "" ">>Distance from vertex" #rel1 pts)
#ang1 (uangle 40 "" ">>First reference angle" #ang1 pts)
#ang2 (uangle 40 "" ">>Second reference angle" #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 "Point not found.") (princ) )
)
)
;
(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
pts (upoint
-88 "" ">>Reference point <Lastpoint>"
(getvar "LASTPOINT") nil
)
)
(while
(setq pt2 (upoint -88 "" ">><Next point>/Return to stop" nil pts))
(setq inc (+ inc (distance pts pt2)))
(prompt
(strcat
"\n>>Distance: " (rtos (distance pts pt2)) " Angle: "
(angtos (angle pts pt2))
" Total distance: " (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 "Point not found.") (princ) )
)
)
;
----------------------------------------------------------------------

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



----------------------------------------------------------------------

Example of use in C:xxx

(defun C:ALE_Triang3Side (/ pt1 pt2 lt2 lt3 sper tng)
(setq
pt1 (upoint 40 "" "First point on first side <Lastpoint>"
(getvar "LASTPOINT") (getvar "LASTPOINT")
)
#mdist (udist 46 "" "Length first side" #mdist pt1)
#ang (uangle 40 "" "Angle first side" #ang pt1)
pt2 (polar pt1 #ang #mdist)
)
(grdraw pt1 pt2 -1 1)
(setq lt2 (udist 46 "" "Length second side" #mdist pt1))
(while (not (and (< lt3 (+ #mdist lt2 )) (> lt3 (abs (- #mdist lt2)))))
(initget (+ 2 8 32))
(setq lt3 (udist 46 "" "Length third side" lt2 pt2))
(if (or (> lt3 (+ #mdist lt2 )) (< lt3 (abs (- #mdist lt2))))
(alert "No triangle exist with this side!")
)
)
(setq
sper (/ (+ lt3 #mdist lt2) 2.0)
tng (sqrt(/ (* (- sper #mdist ) (- sper lt2)) (* sper (- sper lt3))))
)
(command
"_.PLINE" "_NONE" pt1 "_NONE" pt2
"_NONE" (polar pt1 (+ #ang (* 2.0 (atan tng))) lt2) "_C"
)
(princ)
)


(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 ": "))
)
(initget bit kwd)
(setq inp (if bpt (getdist msg bpt) (getdist msg)))
(if inp inp def)
);defun UDIST

(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

--

Marc'Antonio Alessi
http://xoomer.virgilio.it/alessi
(strcat "NOT a " (substr (ver) 8 4) " guru.")

--