;;; - ------------------------------------------------------------------------------ - ;
;;; -                T O O L -  A C M - D I M C H A N G E                            - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung : Verschiedenen Routinen zur Bearbeitung von Bemaßungen           - ;
;;; - Befehle      : DIMRND        Ändern des Rundungsfaktors von Bemaßungen         - ;
;;; -                DIMPRECISION  Ändern der angezeigten Genauigkeit von Bemaßungen - ;
;;; -                DIMCHECK+     Ändern von Bemaßungen in Prüfbemaßungen           - ;
;;; -                DIMCHECK-     Entfernen des Prüfbemaßung-Status                 - ;
;;; -                DIMORG        Entfernen von Bemaßungsüberschreibungen           - ;
;;; -                DIMCBYLAYER   Setzen der Bemaßungsfarben auf "VonLayer"         - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 18.05.2025                                                - ;
;;; -              durch : Thomas Krüger                                             - ;
;;; - ------------------------------------------------------------------------------ - ;
(vl-load-com)
(defun DT:UNDOEND()
  (while(= 8(logand 8 (getvar "undoctl")))
    (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
  )      
)
(defun DT:UNDOSTART()
  (DT:UNDOEND)
  (vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
)
(defun DT:ERROR (MSG)    
  (if(not(wcmatch(strcase MSG t) "*break,*cancel*,*exit*"))      
    (princ (strcat "\nFEHLER: " MSG))
  )
  (DT:UNDOEND)
  (DT:RESET)
  (princ)
)
(defun DT:INIT()  
  (DT:UNDOSTART)        
  (setq ERRORSAVE *error*  *error* DT:ERROR
        OLDCMD(getvar "CMDECHO")
        NOMUTT(getvar "NOMUTT")
  )
)
(defun DT:RESET()  
  (setvar "CMDECHO" OLDCMD)
  (setq *error* ERRORSAVE)
  (mapcar '(lambda(X) (set X nil))(list 'ERRORSAVE))
  (DT:UNDOEND)
  (princ)
)
;;; - Ändern des Rundungsfaktors von Bemaßungen
(defun C:DIMRND(/ FAKTOR AWS INDEX NOMUTT OBJ)
  (DT:INIT)
  (if(and(or(and(=(getvar "PICKFIRST")1)(setq AWS (ssget "_I" '((0 . "DIMENSION")))))
            (and(setq NOMUTT(getvar "NOMUTT"))
                (setvar "NOMUTT" 1)
                (princ "\nBemaßungen wählen: ")
                (or(vl-catch-all-error-p
                     (setq AWS(vl-catch-all-apply'ssget (list  '((0 . "DIMENSION")))))
                   )               
                   'T
                )
                (setvar "NOMUTT" NOMUTT)
                (or(=(type AWS)'PICKSET)(prompt "\nAbbruch durch Anwender..."))   
                (>(sslength AWS)0)
            )
            (prompt "\nKeine Bemaßungen gewählt")
         ) 
         (or(setq FAKTOR(getreal "\nRundungsfaktor <1>:"))
            (setq FAKTOR 1.0)
         )            
     )    
    (progn      
      (setq INDEX -1)
      (repeat (sslength AWS)
        (and(setq OBJ(ssname AWS(setq INDEX (1+ INDEX))))
            (setq OBJ(vlax-ename->vla-object OBJ))
            (not(vl-catch-all-error-p
                  (vl-catch-all-apply
                    'vla-put-RoundDistance (list OBJ FAKTOR)
                  )
                )
            )                         
        )            
      )      
    )  
  )
  (DT:RESET)
  (princ)
)
;;; - Ändern der angezeigten Genauigkeit von Bemaßungen
(defun C:DIMPRECISION(/ FAKTOR AWS INDEX OBJ NOMUTT)
  (DT:INIT)
  (if(and(or(and(=(getvar "PICKFIRST")1)(setq AWS (ssget "_I" '((0 . "DIMENSION")))))
            (and(setq NOMUTT(getvar "NOMUTT"))
                (setvar "NOMUTT" 1)
                (princ "\nBemaßungen wählen: ")
                (or(vl-catch-all-error-p
                     (setq AWS(vl-catch-all-apply'ssget (list  '((0 . "DIMENSION")))) )
                   )               
                   'T
                )
                (setvar "NOMUTT" NOMUTT)
                (or(=(type AWS)'PICKSET)(prompt "\nAbbruch durch Anwender..."))   
                (>(sslength AWS)0)
            )
            (prompt "\nKeine Bemaßungen gewählt")
         ) 
         (or(setq FAKTOR(getint "\nGenauigkeitsstellen <0>:"))
            (setq FAKTOR 0)
         )            
     )
    (progn      
      (setq INDEX -1)
      (repeat (sslength AWS)
        (and(setq OBJ(ssname AWS(setq INDEX (1+ INDEX))))
            (setq OBJ(vlax-ename->vla-object OBJ))
            (not(vl-catch-all-error-p
                  (vl-catch-all-apply
                    'vla-put-PrimaryUnitsPrecision (list OBJ FAKTOR)
                  )
                )
            )                         
        )            
      )      
    )  
  )
  (DT:RESET)
  (princ)
)

;;; - Setzen des Prüfmaßstatus
(defun C:DIMCHECK+(/ OBJPUTXDATA AWS INDEX OBJ NOMUTT)
  (defun OBJPUTXDATA (OBJ NEWXDATA / XDATA DATA)  
    (setq XDATA (assoc -3 (entget OBJ '("*"))))
    (regapp (car NEWXDATA))
    (if (setq DATA(assoc (car NEWXDATA) (cdr XDATA)))
      (setq XDATA(cons -3(subst NEWXDATA DATA(cdr XDATA))))
      (setq XDATA(cons -3 (append (cdr XDATA)(list NEWXDATA))))
    )          
    (entmod(append (entget OBJ) (list XDATA)))
  )
  (DT:INIT)
  (if(and(or(and(=(getvar "PICKFIRST")1)(setq AWS (ssget "_I" '((0 . "DIMENSION")))))
            (and(setq NOMUTT(getvar "NOMUTT"))
                (setvar "NOMUTT" 1)
                (princ "\nBemaßungen wählen: ")
                (or(vl-catch-all-error-p
                     (setq AWS(vl-catch-all-apply'ssget (list  '((0 . "DIMENSION")))) )
                   )               
                   'T
                )
                (setvar "NOMUTT" NOMUTT)
                (or(=(type AWS)'PICKSET)(prompt "\nAbbruch durch Anwender..."))   
                (>(sslength AWS)0)
            )
            (prompt "\nKeine Bemaßungen gewählt")
         )                     
     )
    (progn      
      (setq INDEX -1)
      (repeat (sslength AWS)
        (and(setq OBJ(ssname AWS(setq INDEX (1+ INDEX))))
            (=(type OBJ)'ENAME)
            (=(cdr(assoc 0 (entget OBJ)))"DIMENSION")
            (not(vl-catch-all-error-p
                  (vl-catch-all-apply
                    'OBJPUTXDATA (list OBJ '("ACAD_DSTYLE_DIMINSPECT"
                                              (1070 . 396) (1000 . "")
                                              (1070 . 395) (1000 . "")
                                              (1070 . 394) (1070 . 1)
                                              (1070 . 393) (1070 . 1)
                                            )
                                 )      
                  )
                )
            )
            
        )            
      )      
    )  
  )
  (DT:RESET)
  (princ)
)

;;; - Entfernen des Prüfmaßstatus
(defun C:DIMCHECK-(/ OBJPUTXDATA AWS INDEX OBJ NOMUTT)
  (defun OBJPUTXDATA (OBJ NEWXDATA / XDATA DATA)  
    (setq XDATA (assoc -3 (entget OBJ '("*"))))
    (regapp (car NEWXDATA))
    (if (setq DATA(assoc (car NEWXDATA) (cdr XDATA)))
      (setq XDATA(cons -3(subst NEWXDATA DATA(cdr XDATA))))
      (setq XDATA(cons -3 (append (cdr XDATA)(list NEWXDATA))))
    )          
    (entmod(append (entget OBJ) (list XDATA)))
  )
  (DT:INIT)
  (if(and(or(and(=(getvar "PICKFIRST")1)(setq AWS (ssget "_I" '((0 . "DIMENSION")))))
            (and(setq NOMUTT(getvar "NOMUTT"))
                (setvar "NOMUTT" 1)
                (princ "\nBemaßungen wählen: ")
                (or(vl-catch-all-error-p
                     (setq AWS(vl-catch-all-apply'ssget (list  '((0 . "DIMENSION")))) )
                   )               
                   'T
                )
                (setvar "NOMUTT" NOMUTT)
                (or(=(type AWS)'PICKSET)(prompt "\nAbbruch durch Anwender..."))   
                (>(sslength AWS)0)
            )
            (prompt "\nKeine Bemaßungen gewählt")
         )                     
     )
    (progn      
      (setq INDEX -1)
      (repeat (sslength AWS)
        (and(setq OBJ(ssname AWS(setq INDEX (1+ INDEX))))
            (=(type OBJ)'ENAME)
            (=(cdr(assoc 0 (entget OBJ)))"DIMENSION")
            (not(vl-catch-all-error-p
                  (vl-catch-all-apply
                    'OBJPUTXDATA (list OBJ '("ACAD_DSTYLE_DIMINSPECT"
                                              (1070 . 396) (1000 . "")
                                              (1070 . 395) (1000 . "")
                                              (1070 . 394) (1070 . 33)
                                              (1070 . 393) (1070 . 0)
                                            )
                                 )      
                  )
                )
            )
            
        )            
      )      
    )  
  )
  (DT:RESET)
  (princ)
)


;;; Setzt alle Bemassungsüberschreibungen in der aktuellen Zeichnung zurück
(defun C:DIMORG( / AWS NOMUTT OBJ INDEX)
  (DT:INIT)
  (if(or(and(=(getvar "PICKFIRST")1)(setq AWS (ssget "_I" '((0 . "DIMENSION")))))
        (and(setq NOMUTT(getvar "NOMUTT"))
            (setvar "NOMUTT" 1)
            (princ "\nBemaßungen wählen: ")
            (or(vl-catch-all-error-p
                  (setq AWS(vl-catch-all-apply'ssget (list  '((0 . "DIMENSION")))) )
               )               
              'T
            )
            (setvar "NOMUTT" NOMUTT)
            (or(=(type AWS)'PICKSET)(prompt "\nAbbruch durch Anwender..."))   
            (>(sslength AWS)0)
        )
        (prompt "\nKeine Bemaßungen gewählt")
     )            
    (progn
      (setq INDEX -1)
      (repeat (sslength AWS)
        (and(setq OBJ(ssname AWS(setq INDEX (1+ INDEX))))
            (setq OBJ(vlax-ename->vla-object OBJ))
            (not(vl-catch-all-error-p                              
                  (vl-catch-all-apply
                    ''vla-put-TextOverride (list OBJ "")
                  )
                )
            )                         
        )            
      )      
    )
  )
  (DT:RESET)
)

(defun C:DIMCBYLAYER(/ AWS INDEX OBJ NOMUTT)
  (DT:INIT)
  (if(and(or(and(=(getvar "PICKFIRST")1)(setq AWS (ssget "_I" '((0 . "DIMENSION")))))
            (and(setq NOMUTT(getvar "NOMUTT"))
                (setvar "NOMUTT" 1)
                (princ "\nBemaßungen wählen: ")
                (or(vl-catch-all-error-p
                     (setq AWS(vl-catch-all-apply'ssget (list  '((0 . "DIMENSION")))) )
                   )               
                   'T
                )
                (setvar "NOMUTT" NOMUTT)
                (or(=(type AWS)'PICKSET)(prompt "\nAbbruch durch Anwender..."))   
                (>(sslength AWS)0)
            )
            (prompt "\nKeine Bemaßungen gewählt")
         )          
     )
    (progn      
      (setq INDEX -1)
      (repeat (sslength AWS)
        (and(setq OBJ(ssname AWS(setq INDEX (1+ INDEX))))
            (setq OBJ(vlax-ename->vla-object OBJ))
            (not(vl-catch-all-error-p(vl-catch-all-apply 'vla-put-Color (list OBJ 256))))
            (not(vl-catch-all-error-p(vl-catch-all-apply 'vla-put-DimensionLineColor (list OBJ 256))))
            (not(vl-catch-all-error-p(vl-catch-all-apply 'vla-put-ExtensionLineColor (list OBJ 256))))
            (not(vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextColor (list OBJ 256))))
        )
      )      
    )  
  )
  (DT:RESET)
  (princ)
)
;;; - ------------------------------------------------------------------------------- - ;
(defun ACM-DIMCHANGE:INFO() 
  (mapcar
    'princ
    (list
      "\n\n"
      "\nACM-DIMCHANGE : Verschiedenen Routinen zur Bearbeitung von Bemaßungen" 
      "\n============== "
      "\n(C) Thomas Krüger 2025" 
      "\nE-Mail: tk@cad-od.de"
      "\nBefehlszeilenaufruf : DIMRND / DIMPRECISION / DIMCHECK+ / DIMCHECK- / DIMORG / DIMCBYLAYER\n"   
    )
  )
  (princ)  
)
;;; - ------------------------------------------------------------------------------- - ;
(ACM-DIMCHANGE:INFO)
(princ)

