[编程交流] 更改DimScale，但使用Tolra

(defun c:bf (/ Faktor)
(alert " Achtung     Toleranzen werden entfernt")
 (initget 7)
 (setq Faktor (getreal "\nBemaßungsfaktor: "))
 (setvar "dimscale" Faktor)
 (setvar "mleaderscale" Faktor)
 (princ "\nBemaßung auswählen")
 (setq DimObject (ssget "X" '((0 . "DIMENSION,MULTILEADER"))))
 (command "._-DimStyle" "_A" DimObject "") 
 (vl-load-com)
 (if (ssget "_x" '((0 . "MULTILEADER")))
   (vlax-for item
             (setq
               ss (vla-get-activeSelectionSet
                    (vla-get-activedocument (Vlax-get-acad-object))
                  )
             )
     (if (eq (vla-get-Stylename item) "M1_T70")
       (vl-catch-all-apply 'vla-put-scalefactor (list item Faktor))
     )
   )
 )
)

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (ssname ss (setq i (1- i))) ret))
   )
 )
)
; (KGA_List_Divide_2 '(0 1 2 3 4 5 6 7 8 9)) => ((0 1) (2 3) (4 5) (6 7) (8 9))
; (KGA_List_Divide_2 '(0 1 2 3 4 5 6 7 )   => ((0 1) (2 3) (4 5) (6 7))
(defun KGA_List_Divide_2 (lst / ret)
 (repeat (/ (length lst) 2)
   (setq ret (cons (list (car lst) (cadr lst)) ret))
   (setq lst (cddr lst))
 )
 (reverse ret)
)
; The function assumes the "ACAD" Xdata for dimensions only contains "DSTYLE" items.
(defun c:OverrideScale ( / dat doc elst scl ss)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (initget 7)
 (if
   (and
     (setq scl (getreal "\nScale: "))
     (setq ss (ssget "_:L" '((0 . "DIMENSION,MULTILEADER"))))
   )
   (foreach enm (KGA_Conv_Pickset_To_EnameList ss)
     (setq elst (entget enm '("ACAD")))
     (if
       (vl-position '(0 . "DIMENSION") elst)
       (progn
         (setq dat
           (append
             '(
               (1000 . "DSTYLE")
               (1002 . "{")
             )
             ; Remove (1000 . "DSTYLE"), (1002 . "{"), (1002 . "}") and existing scale override data:
             (apply
               'append
               (vl-remove-if
                 '(lambda (sub) (equal (car sub) '(1070 . 40)))
                 (cdr (KGA_List_Divide_2 (cdadr (assoc -3 elst))))
               )
             )
             (list
               '(1070 . 40)
               (cons 1040 scl)
               '(1002 . "}")
             )
           )
         )
         (regapp "ACAD")
         (entmod
           (list
             (cons -1 enm)
             (list -3 (cons "ACAD" dat))
           )
         )
       )
       (vla-put-scalefactor (vlax-ename->vla-object enm) scl)
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)