TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Kerry on July 06, 2010, 12:56:15 AM
-
Ever had this happen ??
Command:
Select Start Point (ENTER to QUIT) :
Select End Point: 's
Can't reenter LISP.
Invalid point.
Select End Point:
Quite often you may need to set the SNAPANG in the middle of a lisp routine. .. well I often do anyway.
Using a transparent command such as 'Snapang in the middle of a routine when prompted for points works fine
.. except it a pain typing the command
SO, defining SA as an alias for SNAPANG in your pgp solves that.
Except : SNAPANG only accepts selected points ( a pain to select OSNAPS for sometimes ) or a typed angle value (which you may not remember, or get jumbled if you're a little dyslectic )
So a solution that works for me is to define a function ( not a c: command) to select an object and have the routine change SNAPANG to suit the object.
Then, use (vlax-add-cmd with the ACRX_CMD_TRANSPARENT flag to register the command.
Here's the code :
;;;----------------------------------------------------------------------------
;;;----------------------------------------------------------------------------
;;;* Snap to entity.
;;; codehimbelonga kdub
;;;* (KDUB:SnapTo)
(defun kdub:snapto (/ ent elist i li e1 e2 ang tmp)
(if (setq ent
(entsel
(strcat
"\nSNAP TO line,pline,text,insert ... select object OR ENTER for <"
(angtos (getvar "SNAPANG") 0 4)
">:"
)
)
)
(progn (setq ename (car ent) ; (type (car ent))
elist (entget ename)
)
(cond ((= (cdr (assoc 0 elist)) "POLYLINE")
(setq e1 (entget (entnext ename))
e2 (entget (entnext (cdr (assoc -1 e1))))
)
(setq ang (angle (trans (cdr (assoc 10 e1)) 0 1)
(trans (cdr (assoc 10 e2)) 0 1)
)
)
)
((= (cdr (assoc 0 elist)) "LWPOLYLINE")
(setq i (fix (vlax-curve-getparamatpoint
ename
(vlax-curve-getclosestpointto ename (osnap (cadr ent) "nea"))
)
)
ang (angle (trans (vlax-curve-getpointatparam ename i) 0 1)
(trans (vlax-curve-getpointatparam ename (1+ i)) 0 1)
)
)
)
((= (cdr (assoc 0 elist)) "LINE")
(setq ang (angle (trans (cdr (assoc 10 elist)) 0 1)
(trans (cdr (assoc 11 elist)) 0 1)
)
)
)
((member (cdr (assoc 0 elist)) '("TEXT" "MTEXT" "INSERT"))
(setq ang (cdr (assoc 50 elist)))
)
)
(if ang
;;(setvar "SNAPANG" (kdub:rtd ang))
(setvar "SNAPANG" ang)
)
)
)
(prompt (strcat "\n Snap Angle set to "
(angtos (getvar "SNAPANG") 0 4)
" Degrees\n"
)
)
;;(PRINC)
)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
(vlax-add-cmd "saa" 'kdub:snapto "saa" ACRX_CMD_TRANSPARENT )
NOTE : change the 'global-name' "SAA" to whatever suits you.
jsyn, I used saa because the letters are close together on the keyboard, didn't conflict with any other command name
and is sort of an acronym for SnapAngle to Aligned ... works for me :)
Then, in the middle of a lisp routine you can enter 'SAA to transparently select an entity and have the SNAPANG value change to suit.
The command can also be used normally at the command line.
No more stopping commands in the middle ....
-
Nice one Kerry. 8-)
Does that work for ACAD2000 to 2011?
-
Nice one Kerry. 8-)
Does that work for ACAD2000 to 2011?
Have not yet conformed to Rule #1749-5 of the programmers handbook
Hi Alan
Can't test further back than 2010, 2011 at the moment.
Hopefully we'll get enough testers here to be able to tell by the end of the week :-)
-
Kerry, I could kiss you. That's awesome! I've been wondering if it was possible to do this. How did you ever come across: (vlax-add-cmd "saa" 'kdub:snapto "saa" ACRX_CMD_TRANSPARENT )?
Excellent work. A+
Oh, and it works in C3D 2009.
-
Clever.
looks like bits 2 & 4 of cmd-flags could be useful as well.
Thx, Kerry.
:)
-
That's a new one for me - thanks Kerry :wink:
-
what's the difference between
(vlax-add-cmd "saa" 'kdub:snapto "saa" ACRX_CMD_TRANSPARENT )
and
(defun C:saa () (kdub:snapto))
-
what's the difference between
(vlax-add-cmd "saa" 'kdub:snapto "saa" ACRX_CMD_TRANSPARENT )
and
(defun C:saa () (kdub:snapto))
Try executing the latter transparently within an active LISP routine.
-
Try executing the latter transparently within an active LISP routine.
aaha, now i see, thanx
-
Is it possible to pass a return value? For instance in this example:
(defun rc (/ p1 p2 p3 p4 a g om)
(setq om (getvar "OSMODE"))(setvar "OSMODE" (boole 6 (getvar "OSMODE") 16384));(setvar "OSMODE" 0)
(setq p1 (getpoint "\nSelect objects to stretch by (rotated) crossing..."))
(princ "\nOther corner...")
(while (not a)
(setq g (grread T) p3 (cadr g))
(cond ((= (car g) 3) ; PICK BUTTON?
(setq a T)
(redraw)
)
((= (car g) 5) ; POSITIE?
(setq p2 (list (car p1)(cadr p3)))
(setq p4 (list (car p3)(cadr p1)))
(redraw)(grvecs (list -256 p1 p2 p2 p3 p3 p4 p4 p1))
)
)
)
(setvar "OSMODE" om)
(ssget "CP" (list p1 p2 p3 p4))
)
(vlax-add-cmd "RC" 'rc "RC" ACRX_CMD_TRANSPARENT )
.stretch (rc)
works, but .stretch 'rc
doesn't.
-
I recommend using the bit flags because the modes are...ummm...`bit flags' like osnaps are.
In other words: this would the proper syntax:
(vlax-add-cmd "saa" 'kdub:snapto "saa" 1)
-
I recommend using the bit flags because the modes are...ummm...`bit flags' like osnaps are.
In other words: this would the proper syntax:
(vlax-add-cmd "saa" 'kdub:snapto "saa" 1)
I'd call it a "Magic Number" syntax rather than "proper" syntax .
even if the code viewer DID know that 1 represented and had the same value as ACRX_CMD_TRANSPARENT
:-)
-
< ... > How did you ever come across: (vlax-add-cmd "saa" 'kdub:snapto "saa" ACRX_CMD_TRANSPARENT )?
Excellent work. A+
Oh, and it works in C3D 2009.
How?
Necessity and an old memory Alan.
-
Ever had this happen ??
;;;----------------------------------------------------------------------------
;;;----------------------------------------------------------------------------
;;;* Snap to entity.
;;; codehimbelonga kdub
;;;* (KDUB:SnapTo)
(defun kdub:snapto (/ ent elist i li e1 e2 ang tmp)
(if (setq ent
(entsel
(strcat
"\nSNAP TO line,pline,text,insert ... select object OR ENTER for <"
(angtos (getvar "SNAPANG") 0 4)
">:"
...
very good routine! I added some for restoring the variale of "SNAPANG",then it's more convenient.
;;;Creat a command reactor
(defun Creat-Command-Reactor ()
(if (not *CommandReactor*)
(setq *CommandReactor*
(vlr-command-reactor
nil
'((:vlr-commandwillstart . CMD-Start)
(:vlr-commandended . CMD-Ended)
)
)
);setq
);if
)
;;;Save the current SNAPANG
(defun CMD-start (reactor command-list / )
(if (not (member "SAA" command-list))
(setvar "USERR1" (getvar "SNAPANG"))
)
(princ)
)
;;;Restore the current SNAPANG
(defun CMD-Ended (reactor command-list / )
(if (not (member "SAA" command-list))
(setvar "SNAPANG" (getvar "USERR1"))
)
(princ)
)
(Creat-Command-Reactor)
-
I recommend using the bit flags because the modes are...ummm...`bit flags' like osnaps are.
In other words: this would the proper syntax:
(vlax-add-cmd "saa" 'kdub:snapto "saa" 1)
I'd call it a "Magic Number" syntax rather than "proper" syntax .
even if the code viewer DID know that 1 represented and had the same value as ACRX_CMD_TRANSPARENT
:-)
*lol* Cool with me. Its your code not mine.
Quick, what's osmode 247 ?
:P
*** EDIT ***
Ok, ok. I'll try to be less cryptic and/or brief:
My point is: at some point, who cares if they dont know what it is...its their responsibility to know this stuff not yours to hold their hand through everything. If there is a bit flag involved then chances are that there could be some math involved. I say just add a comment and move on.
( (lambda ( / )
;; all my fancy code
(defun ZX ()
(vl-load-com)
(vla-ZoomPickWindow
(vlax-get-acad-object)) )
;; more fancy code
(vlax-add-cmd "ZX" (function ZX) "ZX" 1)
;; 1 = ACRX_CMD_TRANSPARENT
)
)
But, either way its cool with me (I'm not the lisp police)
:)
-
How do I keep from adding 'SAA to APPLOAD to get it to operate immediately? I've added (vl-load-com) which helped some but still cancels the first working command with "Initializing... till I ESC it then it works. that's me --> :idiot2:
-
Hi Scott,
Not sure I understand your question exactly.
I load this sort of stuff from my menu.MNL file or from my ACAD.LSP file.
with something like
(load "kdub_snapto.LSP")
Are you trying to Autoload it ??
with something like
(autoload "kdub_snapto.LSP" '("SAA" "kdub:snapto"))
I'm not sure if that would work ... and don't have AutoCAD handy to test
-
Sure .. long ago but going back thru these helpful routines has me feeling the obligation to comment [Thank] those involved in the work. Having now got my A2K working on my Windows 10 home, it's just great to be here making progress especially with y'all contributing to my class-time!! Thanks again!... More like "can smell the roast a cookin" How Sweet it is... Got kdub:snapto workin fine, just had it named wrong on my autoload https://www.theswamp.org/Smileys/black/uglystupid2.gif