[编程交流] 旋转文字以对齐线条

;;  Text Rotated to the selected object angle
(defun c:TRA() (c:TextRotate2Angle))
(defun c:TextRotate2Angle (/ ss lst pt ang obj
                 get_pt_and_angle )
 (vl-load-com)
 ;;  User selection of curve object
 ;;  return pick point & average angle of curve at pick point
 (defun get_pt_and_angle (prmpt / ent p@pt parA parB pt ang)
   (if (and (setq ent (entsel prmpt))
            (not (vl-catch-all-error-p
                   (setq pt (vl-catch-all-apply
                              'vlax-curve-getClosestPointTo
                              (list (car ent) (cadr ent))
                            )
                   )
                 )
            )
       )
     (progn
       (setq ent  (car ent)
             p@pt (vlax-curve-getParamAtPoint ent pt)
             parA (max 0.0 (- p@pt 0.05))
             parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
             ang (angle (vlax-curve-getPointAtParam ent parA)
                        (vlax-curve-getPointAtParam ent ParB)
                 )
       )
       (list pt ang)
     )
   )
 )
 
 ;;  Get Text to align & object to alignment angle
 ;;  Text is not moved, just rotated to the alignment angle
 ;;  Object must have curve data
 (prompt "\nSelect text object to align.")
 (if (and (or (setq ss  (ssget "_+.:E:S" '((0 . "Text,Mtext"))))
              (prompt "\n**  No Text object selected.  **"))
          (or (setq lst (get_pt_and_angle "\nSelect point on object to label."))
              (prompt "\n**  Missed or no curve data for object."))
      )
   (progn
     (setq pt  (car lst)
           ;; ang (FixTextAngle (cadr lst))
           ang (cadr lst)
           obj (vlax-ename->vla-object (ssname ss 0))
     )
     (vla-put-rotation Obj ang)
   )
   
 )
 (princ)
)

;;  Text Rotated to the selected object angle
(defun c:TRA() (c:TextRotate2Angle))
(defun c:TextRotate2Angle (/ ss lst pt ang obj
                 get_pt_and_angle )
 (vl-load-com)
 ;;  User selection of curve object
 ;;  return pick point & average angle of curve at pick point
 (defun get_pt_and_angle (prmpt / ent p@pt parA parB pt ang)
   (if (and (setq ent (entsel prmpt))
            (not (vl-catch-all-error-p
                   (setq pt (vl-catch-all-apply
                              'vlax-curve-getClosestPointTo
                              (list (car ent) (cadr ent))
                            )
                   )
                 )
            )
       )
     (progn
       (setq ent  (car ent)
             p@pt (vlax-curve-getParamAtPoint ent pt)
             parA (max 0.0 (- p@pt 0.05))
             parB (min (+ p@pt 0.05) (vlax-curve-getEndParam ent))
             ang (angle (vlax-curve-getPointAtParam ent parA)
                        (vlax-curve-getPointAtParam ent ParB)
                 )
       )
       (list pt ang)
     )
   )
 )
 
 ;;  Get Text to align & object to alignment angle
 ;;  Text is not moved, just rotated to the alignment angle
 ;;  Object must have curve data
 (prompt "\nSelect text object to align.")
 (if (and (or (setq ss  (ssget "_+.:E:S" '((0 . "Text,Mtext"))))
              (prompt "\n**  No Text object selected.  **"))
          (or (setq lst (get_pt_and_angle "\nSelect point on object to label."))
              (prompt "\n**  Missed or no curve data for object."))
      )
   (progn
     (setq pt  (car lst)
           ;; ang (FixTextAngle (cadr lst))
           ang (cadr lst)
           obj (vlax-ename->vla-object (ssname ss 0))
     )
     (vla-put-rotation Obj ang)
     (if (zerop (vla-get-Alignment obj))
       (vla-put-InsertionPoint obj (vlax-3d-point pt))
       (vla-put-textalignmentpoint obj (vlax-3d-point pt))
     )
   )
   
 )
 (princ)
)