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

  • Thread starter Thread starter James Allen
  • Start date Start date
J

James Allen

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 !
Tony Tanzillo said:
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")
Click to expand...
 
James,

My pleasure. I was lucky to find it.

And thanks to Tony for his insights.

Joe
 
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
response to any getpoint request, whether from a built-in command or lisp
routine?
Click to expand...
<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.")

--
 
You must log in or register to reply here.

Latest threads

Back
Top