[综合讨论] dimstyle误差减少

; create a list of current dimstyles in the drawing
; get total count/ give each one a number
; if count is greater than zero While (> count 0) ; continue with next DimStyle.
; set the dimstyle current
; change the necessary variables
; save the variables to the current dimstyle
; count down by one after saving that dimstyle
; DimStyle Update Complete.
;(defun SaveDimStyleChanges (style /)
;  (vla-copyfrom
;    (vlax-ename->vla-object (tblobjname "DIMSTYLE" style))
;    (vla-get-activedocument (vlax-get-acad-object))
;  )
;)
; Posted by Terry CADD on AUGI Forums 2008-4-23
; http://forums.augi.com/showthread.php?p=967708#post967708
(defun c:DCBL (/ DimStyles@ StyleName$)
(princ "\nDimstyles color bylayer")
;===========================================================================Turn off command line responses
(command "CMDECHO" 0)        ;DO NOT CHANGE THIS LINE
;===========================================================================
        (setq StyleName$ (cdr (assoc 2 (tblnext "DIMSTYLE" t))))
        (setq DimStyles@ (list StyleName$))
        (setq Count 0)
        
        (while (setq StyleName$ (cdr (assoc 2 (tblnext "DIMSTYLE"))))
                (setq DimStyles@ (append DimStyles@ (list StyleName$)))
        )                ;end while
        
        (foreach StyleName$ DimStyles@
                (command "DIMSTYLE" "R" StyleName$)
                (setvar "DIMCLRD" 256)                                        ;Dimension line and leader color
                (setvar "DIMCLRE" 256)                                        ;Extension line color
                (setvar "DIMCLRT" 256)                                        ;Dimension text color
                (command "DIMSTYLE" "S" StyleName$ "Y")
                (setq Count (+ 1 Count))
                (princ "\n Count = [ ")
                (princ Count)
                (princ " ] picking next DimStyle.....")
        )                ;foreach
 
 (princ)
;===========================================================================Turn off command line responses
(command "CMDECHO" 1)        ;DO NOT CHANGE THIS LINE
;===========================================================================
)                        ;defun

;;  Another way without the Command.
;;  DimStyle to By Layer
;;  CAB 04/28/09
(defun c:DS2BL (/ acdoc dsobj obj)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq dsobj (vla-get-dimstyles acdoc))
  (vlax-for obj dsobj
    (vla-put-activedimstyle acdoc (vla-item dsobj (vla-get-name obj))) ;set dimstyle current
    (vlax-invoke acdoc 'setvariable "DimCLRD" 256) ;Dimension line and leader color
    (vlax-invoke acdoc 'setvariable "DimCLRE" 256) ;Extension line color
    (vlax-invoke acdoc 'setvariable "DimCLRT" 256) ;Dimension text color
    (vla-copyfrom obj acdoc) ; update the Dim Style
  )
  (princ)
)