Try this
Code:
;___________________________________________________________________________________________________________|
;
; Written By: Peter Jamtgaard C.E., P.E., S.E. copyright 2022 All Rights Reserved
;___________________________________________________________________________________________________________|
; Abstract: This function will rotate a block with attributes to match the rotation of a selected line
;___________________________________________________________________________________________________________|
;
; Comand line function list
;___________________________________________________________________________________________________________|
;* C:BAR
;* Command Line Function to rotate a block to match a line
;* C:BlockAndAttributeRotate
;* Command Line Function to rotate a block to match a line
;___________________________________________________________________________________________________________|
;
; General Function Header List
;___________________________________________________________________________________________________________|
;* (AttributeRotate objBlock sngRadians)
;* Function to rotate attributes in a block to radians angle
;* (BlockAndAttributeRotate objLine objBlock)
;* Function to rotate a block and attributes
;* (EntitySelectOne strPrompt lstFilter )
;* Function to select one object with a filter
;* (ErrorTrap symFunction)
;* Function to trap error
;$ EndHeader
;___________________________________________________________________________________________________________|
;
; Command Line Function to rotate a block to match a line
;___________________________________________________________________________________________________________|
(defun C:BAR ()(C:BlockAndAttributeRotate))
(defun C:BlockAndAttributeRotate (/ objBlock objLine)
(if (and (setq objLine (EntitySelectOne "\nSelect Line: " (list (cons 0 "line"))))
(setq objBlock (EntitySelectOne "\nSelect A Block With Attributes: "
(list (cons 0 "insert")(cons 66 1))
)
)
)
(BlockAndAttributeRotate objLine objBlock)
)
)
;___________________________________________________________________________________________________________|
;
; Function to rotate a block and attributes
;___________________________________________________________________________________________________________|
(defun BlockAndAttributeRotate (objLine objBlock / sngRadians)
(if (and (setq sngRadians (vla-get-angle objLine))
(errortrap '(vla-put-rotation objBlock sngRadians))
)
(AttributeRotate objBlock sngRadians)
)
)
;___________________________________________________________________________________________________________|
;
; Function to rotate attributes in a block to radians angle
;___________________________________________________________________________________________________________|
(defun AttributeRotate (objBlock sngRadians / lstAttributeObjects objAttribute)
(if (and (vla-get-hasattributes objBlock)
(setq lstAttributeObjects (vlax-invoke objBlock "getattributes"))
)
(foreach objAttribute lstAttributeObjects
(errortrap '(vla-put-rotation objAttribute sngRadians))
)
)
)
;___________________________________________________________________________________________________________|
;
; Function to select one object with a filter
;___________________________________________________________________________________________________________|
(defun EntitySelectOne (strPrompt lstFilter / entSelection objSelection ssSelections)
(while (not (if (and (princ strPrompt)
(setq ssSelections (ssget ":S:E" lstFilter))
(setq entSelection (ssname ssSelections 0))
)
(setq objSelection (vlax-ename->vla-object entSelection))
)
)
(princ "\nInvalid Selection Please Select Again: ")
)
objSelection
)
;___________________________________________________________________________________________________________|
;
; Function to trap error
;___________________________________________________________________________________________________________|
(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)
)
)
(princ "!")
(vl-load-com)