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