📄 rtrans.lsp
字号:
;;; ;
;;; Returns List In As A Variant Array: ;
;;; ((1.0 0.0 0.0 5.0) ;
;;; (0.0 1.0 0.0 5.0) ;
;;; (0.0 0.0 1.0 5.0) ;
;;; (0.0 0.0 0.0 1.0) ;
;;; ) ;
;;; ;
;;; Usage: (make-translation-matrix '( 5 5 5 )) or ;
;;; (make-translation-matrix (vlax-3d-point '( 5 5 5 ))) ;
;;; ;
;;;--------------------------------------------------------------------;
(defun make-translation-matrix (vector / tm TransDataA TransData)
(if (> (vlax-variant-type vector) 8192)
(setq vector (vlax-safearray->list (vlax-variant-value vector)))
)
(setq tm
(list (list 1 0 0 (car vector))
(list 0 1 0 (cadr vector))
(list 0 0 1 (caddr vector))
'(0 0 0 1)
)
)
;; Convert to a Variant Array of Doubles here ->
(setq TransDataA (vlax-make-safearray vlax-vbDouble (cons 0 3) (cons 0 3)))
(vlax-safearray-fill TransDataA tm)
(setq TransData (vlax-make-variant TransDataA (logior vlax-vbarray vlax-vbDouble)))
)
;;;--------------------------------------------------------------------;
;;; Function: TRANSLATE-VLA-OBJECT ;
;;; ;
;;; Description: This function translates the current ;
;;; transformation values of an object by a supplied ;
;;; vector list. This vector list is a list of three ;
;;; numbers which determine the new values for the ;
;;; existing transformation value. ;
;;; Translate-Vla-Object is similar to ;
;;; translate-object except this function performs ;
;;; error checking before passing the information ;
;;; to translate-object. ;
;;; ;
;;; Note: This function performs ;
;;; error checking. ;
;;; ;
;;; Required Functions: ;
;;; translate-object ;
;;; ;
;;; Example: A line beginning is anchored at 0,0,0. ;
;;; Its ending point is 1,0,0. The transformation ;
;;; value is '(5 5 5). Hence add 5 to the X value, 5 ;
;;; to the Y value and 5 to the Z value. The result ;
;;; will be: ;
;;; The beginning point will have 5,5,5 ;
;;; The ending point will have 6,5,5 ;
;;; ;
;;; The example above demonstrates a different method ;
;;; for moving an object. ;
;;; ;
;;; Arguments: ;
;;; vla-obj = a vla object that can contain ;
;;; transformation verctors. ;
;;; translation-vector = a valid vector list such as: ;
;;; '( 5 5 5) or '( 1.2 4.5 200.00) ;
;;; ;
;;; ;
;;; Returned Value: A vla object ;
;;; ;
;;; Usage: (translate-vla-object vla-Object '( 5 5 5)) ;
;;;--------------------------------------------------------------------;
(defun translate-vla-object (vla-obj translation-vector)
(if (and
vla-obj
(eq 'VLA-OBJECT (type vla-obj))
(vlax-write-enabled-p vla-obj) ; test if object can be modified
)
(translate-object vla-obj translation-vector)
)
)
;;;--------------------------------------------------------------------;
;;; Function: TRANSLATE-OBJECT ;
;;; ;
;;; Description: This function translates the current ;
;;; transformation values of an object by a supplied ;
;;; vector list. This vector list is a list of three ;
;;; numbers which determine the new values for the ;
;;; existing transformation value. ;
;;; Translate-Object is similar to ;
;;; translate-vla-object except this function DOES ;
;;; NOT perform error checking before passing the ;
;;; information to make-translation-matrix. ;
;;; ;
;;; Note: This function DOES NOT performs ;
;;; error checking. ;
;;; ;
;;; Required Functions: ;
;;; translate-object ;
;;; ;
;;; Example: A line beginning is anchored at 0,0,0. ;
;;; Its ending point is 1,0,0. The transformation ;
;;; value is '(5 5 5). Hence add 5 to the X value, 5 ;
;;; to the Y value and 5 to the Z value. The result ;
;;; will be: ;
;;; The beginning point will have 5,5,5 ;
;;; The ending point will have 6,5,5 ;
;;; ;
;;; The example above demonstrates a different method ;
;;; for moving an object. ;
;;; ;
;;; Arguments: ;
;;; vla-obj = a vla object that can contain ;
;;; transformation vectors. ;
;;; translation-vector = a valid vector list such as: ;
;;; '( 5 5 5) or '( 1.2 4.5 200.00) ;
;;; ;
;;; ;
;;; Returned Value: A vla object ;
;;; ;
;;; Usage: (translate-object vla-Object '( 5 5 5)) ;
;;;--------------------------------------------------------------------;
(defun translate-object (obj translation-vector)
(vla-TransformBy
obj
(make-translation-matrix translation-vector)
)
)
;;;--------------------------------------------------------------------;
;;; Function: CREATE-TRANSLATE-CURVE-REACTOR ;
;;; ;
;;; Description: This function creates a curve reactor. ;
;;; ;
;;; Required Functions: ;
;;; save-center-reactor ;
;;; translate-center-reaction ;
;;; ;
;;; Arguments: ;
;;; circles-list = a list of valid vla circles. ;
;;; reactor. ;
;;; curve = a list of valid vla objects which will ;
;;; receive notification. ;
;;; ;
;;; Returned Value: A vlr reactor object. ;
;;; ;
;;; Usage: Should not be used alone and is intended to be ;
;;; be used within a reactor call back event. ;
;;; (save-center-reactor ;
;;; Object-which-is-notifying ;
;;; Reactor-which-has-been-invoked ;
;;; PropertyString) ;
;;;--------------------------------------------------------------------;
(defun create-translate-curve-reactor (circles-list curve)
(VLR-Object-reactor
circles-list ;;owners
(list curve) ;;recievers
(list (cons :vlr-objectClosed (function save-center-reactor))
(cons :vlr-modified (function translate-center-reaction))
)
)
)
;;;--------------------------------------------------------------------;
;;; Function: GET-RADIUS ;
;;; ;
;;; Description: This function prompts the user for a radius from ;
;;; a known point. User input is curtailed via a call ;
;;; to initget whose sum of the bit values determine ;
;;; the behavior of this function. ;
;;; ;
;;; Bit value Description ;
;;; ;
;;; 1 Prevents the user from responding ;
;;; to the request by entering ;
;;; only ENTER. ;
;;; ;
;;; 2 Prevents the user from responding ;
;;; to the request by entering zero. ;
;;; ;
;;; 4 Prevents the user from responding ;
;;; to the request by entering a ;
;;; negative value. ;
;;; ;
;;; 32 Uses dashed lines when drawing ;
;;; rubber-band line or box. For those ;
;;; functions with which the user can ;
;;; specify a point by selecting a ;
;;; location on the graphics screen, ;
;;; this bit value causes the ;
;;; rubber-band line or box to be ;
;;; dashed instead of solid. ;
;;; (Some display drivers use a ;
;;; distinctive color instead of ;
;;; dashed lines.) ;
;;; If the system variable POPUPS ;
;;; is 0, AutoCAD ignores this bit. ;
;;; ;
;;; 64 Prohibits input of a Z ;
;;; coordinate to the getdist ;
;;; function; lets an application ;
;;; ensure that this function returns ;
;;; a 2D distance. ;
;;; ;
;;; Arguments: ;
;;; point = a list of three reals that denotes where the ;
;;; rubber-banding visual aid will commence. ;
;;; ;
;;; Returned Value: a real number denoting a distance ;
;;; ;
;;; Usage: (get-radius '(0 0 0 )) ;
;;;--------------------------------------------------------------------;
(defun get-radius (point)
;| see above for the bit values used = (+ 1 2 4 32 64) |;
(if (eq (type point) 'VARIANT)
(if (> (vlax-variant-type point) 8192)
(setq point (vlax-safearray->list (vlax-variant-value point)))
)
)
(initget 103)
(getdist point "\nSelect radius: ")
)
;;EOF
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -