Code Red > AutoLISP (Vanilla / Visual)
Copy Rotate -Feedback
JohnK:
Can i get some feedback form you guys? I wanted a little tool i can pass on to presptive employers and this is what i came up with.
I coded some of the major stuff in here (But its still not done) but i wanted feed back on the process, code, etc.. (all that good stuff) Let me know if it dosent work or you see a potential bug.
7
--- Code: ---;;;===================================================================;
;;; UNDO GORUPING FUNCTIONS ;
;;;===================================================================;
(defun vl-UndoBegin ()
(vla-StartUndoMark
(vla-get-activedocument (vlax-get-acad-object))))
(defun vl-UndoEnd ()
(vla-EndUndoMark
(vla-get-activedocument (vlax-get-acad-object))))
;;;===================================================================;
;;; Get-EntSelcted ;
;;;-------------------------------------------------------------------;
;;; This function will offer a way for the programer to get an ;
;;; entity or entities already slected on the screen before the ;
;;; program took control. This program was intended for use in an ;
;;; ActiveX program. I have chosen not to use the "Pickfirst" method ;
;;; in accomplishing this task because I wanted a way to do this even ;
;;; if the "pickfirst" variable was toggled to zero. If no entity is ;
;;; currently selected on the screen, this function will prompt the ;
;;; end user to select an entity. ;
;;; ;
;;; Author: John Kaul ;
;;; ;
;;; Returns: Either previously selected entity, a selected entity, or ;
;;; a list of selected entities. ;
;;; ;
;;; Usage: (vlax-ename->vla-object (Get-EntSelcted)) ;
;;; ;
;;;-------------------------------------------------------------------;
;;; Version: 1.1 Added the ability to have more then one selected ;
;;; objects on the screen. ;
;;;===================================================================;
(defun Get-EntSelcted (/ x cntr xlength xlist)
(setq x (cadr (ssgetfirst)))
(if x (setq xlength (sslength x)))
(cond
((= xlength 1)
(setq x (ssname x 0))
(sssetfirst nil)
(redraw x 3))
((> xlength 1)
(setq cntr xlength)
(cond
((>= cntr 2)
(setq cntr (1- xlength))
(while (>= cntr 0)
(setq xlist (cons (ssname x cntr) xlist)
cntr (1- cntr)))
(foreach a xlist (progn (sssetfirst nil) (redraw a 3))))))
)
(if (= nil xlist) x xlist)
)
;;;===================================================================;
;;; Slected-p ;
;;;-------------------------------------------------------------------;
;;; This function will test to see if something is selected on screen ;
;;; ;
;;; Returns: T or nil ;
;;; ;
;;; Author: John Kaul ;
;;; ;
;;; Usage: (if (not (Slected-p)) ;
;;; (vlax-ename->vla-object (car (entsel)))) ;
;;;===================================================================;
(defun Slected-p ()
(and (cadr (ssgetfirst)))
)
;;; FUNCTION
;;; catchs any errors in selection process
;;; returns a valid VLA-OBJECT or nil
;;; *requires* 'Selected-p' by John Kaul
;;;
;;; ARGUMENTS
;;; none
;;;
;;; USAGE
;;; (setq obj (MST-Select-It))
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2003 Mark S. Thomas
;;; mark.thomas@theswamp.org
;;;
;;; VERSION
;;; 1.0 Tue Sep 16, 2003 07:04:21
;;; 1.1 Mon Nov, 10 2003 ~I chaged the "if" expression to
;;; a "cond" and added a highlight
;;; feature. John Kaul
(defun MST-Select-It (/ obj)
(if
(vl-catch-all-error-p
(cond
((not (Slected-p))
(setq obj
(vl-catch-all-apply
'vlax-ename->vla-object
(list (setq ent (car (entsel))))
)
)
(redraw ent 3)
)
)
)
(setq obj nil)
)
obj
)
;;;*******************************************************************;
;;; copy rotate ;
;;;-------------------------------------------------------------------;
;;; This function will eventualy be a new command in autocad. It will ;
;;; over the user to copy rotate an object. ;
;;; ;
;;; TODO: Rotate the object. ;
;;; Error trap ;
;;;*******************************************************************;
(princ "\nType \"CR\" to run. ")
(defun c:cr ( )
(vl-UndoBegin)
(cond
((not (Slected-p))
(setq obj (MST-Select-It)))
((Slected-p)
(setq obj (vlax-ename->vla-object (Get-EntSelcted))))
)
(vla-Copy obj)
(vla-Move obj
(vlax-3d-point
(setq pt (getpoint
"\nSpecify first point:")))
(vlax-3d-point
(setq pt2 (getpoint pt
"Specify second point:")))
)
;;; (vla-Rotate obj pt2)
(vl-UndoEnd)
)
--- End code ---
Ron Heigh:
--- Code: ---UNDO GORUPING FUNCTIONS
--- End code ---
What does this mean?
Columbia:
I don't know how far you are already in this, but here are just a few tips that may (or may not) save you a few headaches down the road...
1.) in the vl-UndoBegin sub-function I recommend that you add a vla-EndUndoMark call to close any marks or groups that have been left hangin' around and open like this:
--- Code: ---
(defun vl-UndoBegin ()
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
)
--- End code ---
2.) that you add a custom Error Handler function to set the EndUndoMark at unexpected function interruption (i.e. the user hits 'Escape' about 100 x's.)
--- Code: ---
(defun *error* (s)
(if
( (not
(member (strcase s t)
'("quit / exit abort" "function cancelled" "console break")
)
)
(progn (princ (strcat "\nError: " s)) (vl-bt))
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
--- End code ---
What you would want to do at this point is to make sure that this error handler function is a localized defun inside the main routine. That way it doesn't clobber the pre-set AutoCAD one.
3.) you might want to consider putting your selection calls in a (while) loop to ensure that you get something, or if you don't that you don't cause the program to fail.
Any questions about what I'm talking about, then please ask...otherwise Good Luck!
JohnK:
That "close any undo's" is a good idea. Im goona use that one.
Error trap was on the list of TODO.
while loop is also a good idea. (I was thinking the same thing. ...I got one i use for alot of apps that didnt get in here yet.)
Thanks for the reply
OBTW, Did you ever get your XML problems solved? (I dont know if you emailed me or not, but i dont have that email addy i gave you anymore. So...)
Columbia:
Yeah, I found the answer I was looking for. Curiously enough on the Microsoft MSDN website. Go figure, I guess you can acutally find useful information on there. :-)
Anyway, I hoped I helped a little. If you have any other questions/comments/concerns or random shots of profanity, well then I'm all ears.
Navigation
[0] Message Index
[#] Next page
Go to full version