Shorter more powerful function calls

[peter]

I had a discussion last year with a member here about error handling.

So I came up with example that demonstrates what I was talking about.

I get tired of typing vla-get- and vla-put- or vlax-get and vlax-put on every activex command,
I get tired of wrapping an error trap around each ActiveX call.
I get tired of converting entity names, elists, handles, objectID's to objects before every Activex call.

Hence I present a useful alternative.

I am interested in your opinions.

;___________________________________________________________________________________________________________
; 
; Function builder to create new function calls that include
; Written By: Peter Jamtgaard copyright 2015
;___________________________________________________________________________________________________________

; Errortrapping
; 	Returns T or Value for success
; 	Returns nil for failure
; 	Changes objects on locked layers


; Shorter Names 
; 	vla-get-color becomes color
;	vla-put-color becomes colorput
;	 

; Various methods of referencing an object including
; 	vla-Object
;	Ename
; 	Entsel
; 	Elist
; 	Handle
; 	ObjectID
;

; Accepts Variant Safearrays and Lists as arguments (like for points)
; Return Lists in lieu of Variant Safearrays for points.

; Four properties already are lisp expressions Angle, Handle, Length and Type so those functions are
; AngleGet, HandleGet, LengthGet and TypeGet

; Ability to personalize functions to your developer prefix by changing the strPrefix string below.

;___________________________________________________________________________________________________________
;
; Function to demonstrate functionality
;___________________________________________________________________________________________________________

(defun C:TestShort (/ entSelection lstSelection objSelection strHandle)
 (and
  (setq lstSelection (entsel "\nSelect Object: "))
  (setq entSelection (car lstSelection))
  (setq objSelection (vlax-ename->vla-object entSelection))
  (setq strHandle    (handleGet lstSelection))
  (layerput entSelection "0")
  (linetypeput objSelection "Hidden"); If Hidden exists
;  (colorput entSelection -1); <- Causes Error and stops routine
  (princ "\nComplete")
 )
)


;___________________________________________________________________________________________________________
;
; Function to build new functions calls
;___________________________________________________________________________________________________________

(defun FunctionBuild (strFunctionName / strPrefix strSuffix)
 (setq strPrefix "")
 (setq strSuffix "")
 (or
  (and (wcmatch (strcase strFunctionName) "VLA-GET-*")  
       (or 
        (and
         (wcmatch (strcase (substr strFunctionName 9)) "ANGLE,LENGTH,TYPE,HANDLE")
         (GetFunction strFunctionName strPrefix (strcat strSuffix "Get"))
        )   
        (GetFunction strFunctionName strPrefix strSuffix)                 
       )
  )
  (and (wcmatch (strcase strFunctionName) "VLA-PUT-*")      
       (PutFunction strFunctionName strPrefix strSuffix)                 
  )
 )
)

;___________________________________________________________________________________________________________
; 
; Function to create new functions to read (get) com properties with built in error checking
;___________________________________________________________________________________________________________

(defun GetFunction (strFunctionName strPrefix strSuffix)
 (and
  (setq strFunctionName (substr strFunctionName 9))
  (eval 
   (read 
    (strcat "(defun " (strcat strPrefix strFunctionName strSuffix)
            " (obj)(errortrap '(vlax-get (toobject obj) \"" strFunctionName "\")))")
   )
  )
 )
)

;___________________________________________________________________________________________________________
; 
; Function to create new functions to manipulating (put) com properties with built in error checking
;___________________________________________________________________________________________________________


(defun PutFunction (strFunctionName strPrefix strSuffix)
 (and
  (setq strFunctionName (substr strFunctionName 9))
  (eval 
   (read 
    (strcat "(defun " (strcat strPrefix strFunctionName strSuffix)
            "Put (obj Value)(propertyput (toobject obj) \"" strFunctionName "\" Value))")
   )
  )
 )
)

;___________________________________________________________________________________________________________
; 
; Standard Error Trap
;___________________________________________________________________________________________________________

(defun ErrorTrap (symFunction / objError result)
 (if (vl-catch-all-error-p
      (setq objError (vl-catch-all-apply
                     '(lambda (X)(set X (eval symFunction)))
                      (list 'result))))
  nil
  (if result result 'T)
 )
)

;___________________________________________________________________________________________________________
; 
; The toobject function converts objects, entitynames, entity selections, entitylists, handles or objectid's 
; to object references. Returns nil if unsuccessful.
;___________________________________________________________________________________________________________


(defun ToObject (value / symType) 
 (setq symType (type value))
; Vla-Object
 (if (= symType 'vla-object)                
  value
; Entity Name
  (if (= symType 'ENAME)                     
   (vlax-ename->vla-object value)
; Handle
   (if (and (= symType 'STR)
            (setq value (handent value))         
            (entget value))                   
    (toobject value)
; EntSelection
    (if (and (= symType 'LIST)
             (= (type (car value)) 'ENAME))    
     (toobject (car value))
; Entity List
     (if (and (= symType 'LIST)
              (= (type (car value)) 'LIST)                                                 
              (= (type (cdar value)) 'ENAME)     
         )                                      
      (toobject (cdar value))
; Object ID
      (if (and (= symType 'INT)
               (= (strlen (itoa value)) 10))
       (errortrap (quote (vla-objectidtoobject 
                          (vla-get-activedocument 
                           (vlax-get-acad-object)) 
                          value
                         )
                  )
       )
      )
     )
    )
   )
  )
 )
)
 
(vl-load-com)

;See next post for rest of code or look at attachment


(apply 'or (mapcar 'FunctionBuild (atoms-family 1)))

[peter]

;;_________________________________________________________________________________________________________|
;; 
;; Written By: Peter Jamtgaard copyright 2015
;; Put property wrapper that protects the vlax-put-property expression from errors.
;; 1.) Converts object, ename, handle, objectid or entity list to object.
;; 2.) Checks to see if the property is available for the object
;; 3.) If the object is on a locked layer it unlocks the layer modifies the object and relocks the layer.
;; 4.) It opens the object for read and checks the property value against the new value.
;;     If the values are equivalent it ignores the open for write expression.
;;_________________________________________________________________________________________________________|

;;_________________________________________________________________________________________________________|
;
; Function for changing an objects property value. 
; The function checks the new value against current value 
; before changing the value and errortraps the put property action.
;;_________________________________________________________________________________________________________|

(defun PropertyPut (objItem 
                    strProperty 
                    value
                    /

;_________________
; Local Variables |
;_________________|

                    blnReturn
                    objLayerLock
;_________________
; Local Functions |
;_________________|
                    LayerLockCheck
                    LayerLockReset
                   )
;;_________________________________________________________________________________________________________|
; Local Functions
;__________________________________________________________________________________________________________|


;;___________________________________________________________________________________________________________|
;; 
;; Local Function that checks an objects layer for vla-get-locked is :vlax-true, 
;; Returns nil if unlocked (if unlocked) or unlocks the layer and returns the layer 
;; collection object
;;___________________________________________________________________________________________________________|

 (defun LayerLockCheck (objItem
                        / 
                        objLayer 
                       )
  (if (vlax-property-available-p objItem "layer")
   (progn
    (setq objLayer (vla-item (vla-get-layers 
                              (vla-get-document objItem))                                         
                             (vla-get-layer objItem)))
    (if (= (vla-get-lock objLayer) :vlax-true)
     (progn
      (vla-put-lock objLayer :vlax-false)
      objLayer
     )
    )
   )
  )
 )

;;___________________________________________________________________________________________________________|
;; 
;; Function to reset a locked layer to be locked
;; This function works with PropertyPut and the LayerLockCheck functions
;;___________________________________________________________________________________________________________|

 (defun LayerLockReset (objLayerLock)
  (if objLayerLock
   (PropertyPut objLayerLock "lock" :vlax-true)
  )
 )


;___________________________________________________________________________________________________________|
;
; Global PropertyPut base function
;___________________________________________________________________________________________________________| 
 
 (if (and (setq objItem (ToObject objItem))
          (vlax-property-available-p objItem strProperty)
     )
  (if (or (equal (vlax-get          objItem strProperty) value)
          (equal (vlax-get-property objItem strProperty) value)
      )
   (setq blnReturn T)
   (progn
    (setq objLayerLock (LayerLockCheck objItem))
    (if (or (= (type value) 'variant)
            (= (type value) 'SYM)
        )
     (if (errortrap (quote (vlax-put-property objItem strProperty value)))
      (setq blnReturn T)    
     )
     (if (errortrap (quote (vlax-put objItem strProperty value)))
       (setq blnReturn T)    
     )    
    )
    (LayerLockReset objLayerLock)
   )
  )
 )
 blnReturn
)


(vl-load-com)

The rest of the code!

[Tom Beauford]

Looks great! Now even I may be able to write error proof code. Got a few ideas already that will be starting with (load "ShortFunctions.lsp").

Thank you,