; MATCHHATCHORIGIN select source hatch & change target hatch origin to match
; OP: 
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/hatch-apperance-change/td-p/13689907
(defun c:MATCHHATCHORIGIN (/ base-ent base-data base-pattern base-scale base-angle base-x base-y 
                                  ss i ent target-data target-pattern target-scale target-angle
                                  new-x new-y new-data)
  (princ "\nSelect BASE hatch (reference pattern): ")
  (setq base-ent (car (entsel)))
  
  (if (and base-ent (= (cdr (assoc 0 (entget base-ent))) "HATCH"))
    (progn
      
      (setq base-data (entget base-ent))
      (setq base-pattern (cdr (assoc 2 base-data)))    
      (setq base-scale (cdr (assoc 41 base-data)))     
      (setq base-angle (cdr (assoc 52 base-data)))     
      (setq base-x (cdr (assoc 43 base-data)))         
      (setq base-y (cdr (assoc 44 base-data)))         
      
    
      (if (not base-scale) (setq base-scale 1.0))
      (if (not base-angle) (setq base-angle 0.0))
      (if (not base-x) (setq base-x 0.0))
      (if (not base-y) (setq base-y 0.0))
      
      (princ (strcat "\nBase hatch - Pattern: " (if base-pattern base-pattern "SOLID")
                     " Scale: " (rtos base-scale 2 3)
                     " Angle: " (rtos (* base-angle 180.0 pi) 2 1) "°"
                     " Origin: X=" (rtos base-x 2 3) " Y=" (rtos base-y 2 3)))
      
      
      (princ "\nSelect target hatches to align pattern: ")
      (setq ss (ssget '((0 . "HATCH"))))
      
      (if ss
        (progn
          (setq i 0)
          (repeat (sslength ss)
            (setq ent (ssname ss i))
            
            (if (/= ent base-ent)
              (progn
                (setq target-data (entget ent))
;                (setq target-pattern (cdr (assoc 2 target-data)))
;                (setq target-scale (cdr (assoc 41 target-data)))
;                (setq target-angle (cdr (assoc 52 target-data)))
                
               
;                (if (not target-scale) (setq target-scale 1.0))
;                (if (not target-angle) (setq target-angle 0.0))
                
                
;                (if (and (equal base-pattern target-pattern)
;                         (equal base-scale target-scale 0.001)
;                         (equal base-angle target-angle 0.001))
;                  (progn
                    
                    (setq new-data target-data)
                    
                    (if (assoc 43 new-data)
                      (setq new-data (subst (cons 43 base-x) (assoc 43 new-data) new-data))
                      (setq new-data (append new-data (list (cons 43 base-x))))
                    )
                    (if (assoc 44 new-data)
                      (setq new-data (subst (cons 44 base-y) (assoc 44 new-data) new-data))
                      (setq new-data (append new-data (list (cons 44 base-y))))
                    )
                    
                    (if (entmod new-data) ; update 
                      (progn
                        (entupd ent)
                        (princ (strcat "\nHatch " (itoa (1+ i)) " pattern aligned successfully."))
                      )
                      (princ (strcat "\nFailed to align hatch " (itoa (1+ i))))
                    )
;                  )
;                  (princ (strcat "\nHatch " (itoa (1+ i)) " skipped - different pattern/scale/angle."))
;                )
              )
            )
            (setq i (1+ i))
          )
          (princ (strcat "\nProcessed " (itoa (sslength ss)) " hatch(es)."))
        )
        (princ "\nNo target hatches selected.")
      )
    )
    (princ "\nSelected object is not a hatch or selection cancelled.")
  )
  (princ)
)