;;; (c) 2012 Ediciones ARTUAL, S.L. Barcelona, España.
;;; Copyright © 2012-2020 by Reinaldo N. Togores. All rights reserved.
;;; Use of this code is allowed mentioning the book and its author.
;;;Chapter 6. ActiveX Data and Structures
;;;6.1.Safearrays
(defun ax-square? (matrix / dim tmp)
(setq dim 1)
(repeat (vlax-safearray-get-dim matrix)
(setq tmp (cons
(- (vlax-safearray-get-u-bound matrix dim)
(vlax-safearray-get-l-bound matrix dim))
tmp)
dim (1+ dim)))
(apply '= tmp))
;;;Listing 6.1. AX-SQUARE? function.
(defun ax-safearrayp (datum)
(eq (type datum) 'safearray))
;;;Listing 6.2. AX-SAFEARRAYP predicate.
(defun ax-matrix->list (s-arr)
(if (ax-safearrayp s-arr)
(vlax-safearray->list s-arr)))
;;;Listing 6.3. AX-MATRIX->LIST function.
(defun ax-data-type (lst)
(if
(apply 'and
(mapcar '(lambda (x y) (eq (type x) (type y)))
lst
(cdr lst)))
(ax-type (car lst))
vlax-vbVariant))
;;;Listing 6.4. AX-DATA-TYPE.
(defun ax-type (datum)
(setq datum (type datum))
(cond
((eq datum 'INT) vlax-vbLong)
((eq datum 'REAL) vlax-vbDouble)
((eq datum 'STR) vlax-vbString)
((eq datum 'VLA-OBJECT) vlax-vbObject)
(t vlax-vbVariant)))
;;;Listing 6.5. AX-TYPE function.
(defun ax-list->array (lst)
(vlax-safearray-fill
(vlax-make-safearray
(ax-data-type lst)
(cons 0 (1- (length lst))))
lst))
;;;Listing 6.6. AX-LIST->ARRAY function.
;;;6.6.Collections Processing.
(defun ax-on-off (drawing)
(vlax-map-collection
(vla-get-layers drawing)
'(lambda (x)
(if (equal (vla-get-LayerOn x) :vlax-true)
(vla-put-LayerOn x :vlax-false)
(vla-put-LayerOn x :vlax-true)))))
;;;Listing 6.7. Function to turn Layers on/off using ActiveX.
(defun ax-layer-list (drawing / layers)
(vlax-for lyr
(vla-get-layers drawing)
(setq layers (cons (vla-get-name lyr) layers)))
(acad_strlsort layers))
;;;Listing 6.8. Extracting a list of the drawing's Layers using ActiveX.
(defun ax-names-list (drawing name / collection names)
(setq collection (vlax-get-property drawing name))
(vlax-for obj
collection
(setq names (cons (vla-get-name obj) names)))
(acad_strlsort names))
;;;Listing 6.9. Generic function to obtain the names of objects in a collection.
;;;6.7.Managing exceptions.
(defun tan~ (ang) (/ (sin ang) (cos ang)))
;;;Listing 6.10. Tangent calculation without anticipating a division by zero.
(defun tan (ang / cosine)
(if (zerop (setq cosine (cos ang)))
1.8E+308
(/ (sin ang) cosine)))
;;;Listing 6.11. Calculation of the tangent anticipating for the division by zero.
(defun ax-exists? (item collection)
(not
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-item
(list collection item)))))
;;;Listing 6.12. Checking for an item in a collection.
(defun ax-exists? (item collection / result)
(if
(not
(vl-catch-all-error-p
(setq result (vl-catch-all-apply
'vla-item
(list collection item)))))
result))
;;;Listing 6.13. AX-EXISTS? function that returns the VLA-object.
No comments:
Post a Comment