?? rutils.lsp
字號:
;;; Description: This function mimics the AutoLISP entsel function.;
;;; The difference is that the return value is a ;
;;; vla-object. ;
;;; ;
;;; Arguments: none ;
;;; ;
;;; Returned Value: A the selected item as a vla-object ;
;;; such as: ;
;;; #<VLA-OBJECT IAcadCircle 01b42790> ;
;;; ;
;;; Usage: (vlasel) ;
;;;--------------------------------------------------------------------;
(defun vlasel (/ sel)
(if (setq sel (entsel))
(vlax-ename->vla-object (car sel))
)
)
;;;--------------------------------------------------------------------;
;;; Function: VLA-SEL ;
;;; ;
;;; Description: This function mimics the AutoLISP entsel function.;
;;; The difference is that the return value is a ;
;;; vla-object. ;
;;; ;
;;; Arguments: ;
;;; message = A string or nil. If nil the entsel ;
;;; function is called without arguments. ;
;;; If this argument not nil and is a string, the ;
;;; entsel function is passed the string value. ;
;;; ;
;;; Returned Value: A the selected item as a vla-object ;
;;; such as: ;
;;; #<VLA-OBJECT IAcadCircle 01b42790> ;
;;; ;
;;; Usage: (vla-sel "\nSelect an Object:") or (vla-sel nil) ;
;;;--------------------------------------------------------------------;
(defun vla-sel (message / sel)
(if (setq sel (if (equal (type message) 'STR)
(entsel message)
(entsel)
)
)
(vlax-ename->vla-object (car sel))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Special Selection Set Utilities ;
;;;--------------------------------------------------------------------;
;;; Function: SELECT-VLA-CIRCLES ;
;;; ;
;;; Description: This function prompt the user to select objects ;
;;; from the ACAD screen and applies a filter to the ;
;;; selection set. ;
;;; ;
;;; Arguments: none ;
;;; ;
;;; Returned Value: A list of all circles as vla-objects ;
;;; such as: ;
;;; ( ;
;;; #<VLA-OBJECT IAcadCircle 01b4211c> ;
;;; #<VLA-OBJECT IAcadCircle 01b42790> ;
;;; #<VLA-OBJECT IAcadCircle 01b429a0> ;
;;; ) ;
;;; ;
;;; Usage: (select-vla-circles) ;
;;;--------------------------------------------------------------------;
(defun select-vla-circles ()
(ssget->vla-list (ssget '((0 . "CIRCLE"))))
)
;;;--------------------------------------------------------------------;
;;; Function: SELECT-VLA-CIRCLES-ARC ;
;;; ;
;;; Description: This function prompt the user to select objects ;
;;; from the ACAD screen and applies a filter to the ;
;;; selection set. ;
;;; ;
;;; Arguments: none ;
;;; ;
;;; Returned Value: A list of all circles or arcs as vla-objects ;
;;; such as: ;
;;; ( ;
;;; #<VLA-OBJECT IAcadCircle 01b4211c> ;
;;; #<VLA-OBJECT IAcadCircle 01b42790> ;
;;; #<VLA-OBJECT IAcadCircle 01b429a0> ;
;;; ) ;
;;; ;
;;; Usage: (select-vla-circles-arc) ;
;;;--------------------------------------------------------------------;
(defun select-vla-circles-arc ()
(ssget->vla-list
(ssget
'((-4 . "<OR") (0 . "CIRCLE") (0 . "ARC") (-4 . "OR>"))
)
)
)
;;;--------------------------------------------------------------------;
;;; Function: REMOVE-FROM-ALL-REACTORS ;
;;; ;
;;; Description: This function removes all associations with ;
;;; any object reactor that pertains to the object. ;
;;; ;
;;; Arguments: ;
;;; vla-obj = a valid vla object ;
;;; ;
;;; Returned Value: The last reactor which was modified. ;
;;; ;
;;; Usage: (remove-from-all-reactors my-vla-object ) ;
;;;--------------------------------------------------------------------;
(defun remove-from-all-reactors (vla-obj)
(foreach reactor (vlr-reactors :vlr-object-reactor)
(vlr-owner-remove reactor vla-obj)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Geometry Utilities ;
;;;--------------------------------------------------------------------;
;;; Function: ADD-VECTOR ;
;;; ;
;;; Description: This function returns the addition of ;
;;; two vectors. ;
;;; ;
;;; Arguments: ;
;;; v1 = a valid vector list such as: ;
;;; '( 5 5 5 ) ;
;;; v2 = a valid vector list such as: ;
;;; '( 2 2 2 ) ;
;;; ;
;;; Returned Value: A vector list with the subtraction performed ;
;;; from v1 and v2. ;
;;; (add-vector '(5 5 5 ) '(2 2 2)) ;
;;; Returns: ;
;;; (7 7 7) ;
;;; ;
;;; Usage: (add-vector '(5 5 5 ) '(2 2 2 )) ;
;;;--------------------------------------------------------------------;
(defun add-vector (v1 v2)
(if (eq (type v1) 'VARIANT)
(if (> (vlax-variant-type v1) 8192)
(setq v1 (vlax-safearray->list (vlax-variant-value v1)))
)
)
(if (eq (type v2) 'VARIANT)
(if (> (vlax-variant-type v2) 8192)
(setq v2 (vlax-safearray->list (vlax-variant-value v2)))
)
)
(mapcar '+ v1 v2))
;;;--------------------------------------------------------------------;
;;; Function: SUBTRACT-VECTOR ;
;;; ;
;;; Description: This function returns the subtraction of two ;
;;; vectors. ;
;;; ;
;;; Arguments: ;
;;; v1 = a valid vector list such as: ;
;;; '( 5 5 5 ) ;
;;; v2 = a valid vector list such as: ;
;;; '( 1 1 1 ) ;
;;; ;
;;; Returned Value: A vector list with the subtraction performed ;
;;; from v1 and v2. ;
;;; (subtract-vector '(5 5 5 ) '(1 1 1)) ;
;;; Returns: ;
;;; (4 4 4) ;
;;; ;
;;; Usage: (subtract-vector '(5 5 5 ) '(1 1 1)) ;
;;;--------------------------------------------------------------------;
(defun subtract-vector (v1 v2) (vlax-3d-point (mapcar '- v1 v2)))
;;;--------------------------------------------------------------------;
;;; Function: MULT-BY-SCALAR ;
;;; ;
;;; Description: This function returns the multiplication of ;
;;; a vector to a number. ;
;;; ;
;;; Required Functions: ;
;;; mult-by-scalar ;
;;; ;
;;; Arguments: ;
;;; vect = a valid vector list such as: ;
;;; '( 5 5 5 ) ;
;;; scalar = a valid number ;
;;; ;
;;; Returned Value: A vector list with the multiplication of the ;
;;; scalar argument with the supplied vector list. ;
;;; (mult-by-scalar '(5 5 5 ) 12) ;
;;; Returns: ;
;;; (60 60 60) ;
;;; ;
;;; Usage: (mult-by-scalar '(5 5 5 ) 12) ;
;;;--------------------------------------------------------------------;
(defun mult-by-scalar (vect scalar / sv TransDataA TransData)
(if (> (vlax-variant-type vect) 8192)
(setq vect (vlax-safearray->list (vlax-variant-value vect)))
)
(setq sv (if (null vect)
nil
(cons (* scalar (car vect))
(mult-by-scalar (cdr vect) scalar)
)
))
;; Convert to a Variant Array of Doubles here ->
(setq TransDataA (vlax-make-safearray vlax-vbDouble (cons 0 3)))
(vlax-safearray-fill TransDataA sv)
(setq TransData (vlax-make-variant TransDataA (logior vlax-vbarray vlax-vbDouble)))
)
;;;--------------------------------------------------------------------;
;;; Function: UNIT-VECTOR ;
;;; ;
;;; Description: This function returns the normal for the ;
;;; vector supplied. ;
;;; ;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -