TORIENT & Other LSP

[andy.204833]

I have a block containing DTEXT and a block attribute (its for heights on beams and reads "BH 2.01"). The "BH" is the DTEXT, Middle Right justified and the "2.01" is the attribute Middle Left justified). The block insertion point is the centre of whole text string.

I have an align lsp which you click the block and click a line and the block rotates to match the angle of the line. Whilst the block rotates, this only rotates the DTEXT in the block and not the attribute. If I use TORIENT from Express Tools, the block rotates again but rotates the attribute and not the DTEXT. What I'm looking for is a routine / command / workflow that rotates the whole block (and everything in it) to match a line or polyline around the block insertion point?

AutoCAD 2022
Win 10 Pro

Many thanks

[Ed Jobe]

Hi Andy, welcome to AUGI.

Good description, but you might also want to post a sample of your block.

[Tharwat]

Its simple enough, just add a few codes to your align lisp to rotate the attribute when rotating the block itself.

[andy.204833]

Thanks for the responses - its a lisp I've inherited and I don't know lisp as such - Can anyone point me towards the correct lisp command / routine to look into please?

[Tharwat]

Just add the following after selecting the block entity along with the angle value.

;; Where :
;; blk = is Block entity.
;; ang = is the angle value.

(foreach att (vlax-invoke (vlax-ename->vla-object blk) 'GetAttributes)
  (vla-put-rotation att ang)
  )

[Opie]

;; ang = is the angle value.

The supplied ang value should be in radians, correct?

[Tharwat]

The supplied ang value should be in radians, correct?

Yeah correct.

[BIG-AL]

You may need these as well.

;The dtr function converts degrees to radians
;The rtd function converts radians to degrees
(defun dtr (a)
(* pi (/ a 180.0))
)
;
(defun rtd (a)
(/ (* a 180.0) pi)
)

[Tom Beauford]

Thanks for the responses - its a lisp I've inherited and I don't know lisp as such - Can anyone point me towards the correct lisp command / routine to look into please?

Many of us probably have already written code solutions that do what you want but without an attachment or link to a drawing to test it on we're reluctant to post them.

[peter]

Try this

;___________________________________________________________________________________________________________|
;
; 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)