Lee Mac 发表于 2022-7-6 07:08:12

 
Wow! This is an old thread - this takes me back to when I first started with LISP.... embarassing times
 
I'll take a look over the code when I get a minute Glen

Lee Mac 发表于 2022-7-6 07:10:58

Give this a shot Glen, perhaps slightly overkill but oh well:
 

(defun c:DimUpd ( / *error* _StartUndo _EndUndo DimLayer DimStyle doc lck ss ) (vl-load-com) ;; © Lee Mac 2010 (setq DimLayer "Dims" DimStyle "Standard") (defun *error* ( msg )      (if lck (LM:RelockLayers lck))   (if doc (_EndUndo doc))      (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")       (princ (strcat "\n** Error: " msg " **")))   (princ) ) (defun _StartUndo ( doc ) (_EndUndo doc)   (vla-StartUndoMark doc) ) (defun _EndUndo ( doc )   (if (= 8 (logand 8 (getvar 'UNDOCTL)))   (vla-EndUndoMark doc)   ) ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (tblsearch "LAYER" DimLayer)   (vla-Add (vla-get-Layers doc) DimLayer) ) (or (tblsearch "DIMSTYLE" DimStyle)   (vla-Add (vla-get-DimStyles doc) DimStyle) ) (if (ssget "_X" '((0 . "*LEADER,*DIMENSION")))   (progn   (_StartUndo doc) (setq lck (LM:UnlockLayers doc))   (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))       (vl-catch-all-apply         (function         (lambda nil             (mapcar               (function               (lambda ( p v ) (vlax-put-property obj p v))               )            '(Layer Stylename)               (list DimLayer DimStyle)             )         )         )       )   )   (vla-delete ss)   (LM:RelockLayers lck) (_EndUndo doc)    ) ) (princ))         ;;------------------=={ Unlock Layers }==---------------------;;;;                                                            ;;;;Unlocks all layers in the supplied Document Object and    ;;;;returns a list of those which were locked               ;;;;------------------------------------------------------------;;;;Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;;;------------------------------------------------------------;;;;Arguments:                                                ;;;;doc - VLA Document Object                                 ;;;;------------------------------------------------------------;;;;Returns:list of previously locked VLA Layer Objects   ;;;;------------------------------------------------------------;;(defun LM:UnlockLayers ( doc / r ) (vlax-for l (vla-get-layers doc)   (if (eq :vlax-true (vla-get-lock l))   (vla-put-lock (car (setq r (cons l r))) :vlax-false)   ) ) (reverse r));;-------------------=={ ReLock Layers }==--------------------;;;;                                                            ;;;;Locks all layers in the supplied list                     ;;;;------------------------------------------------------------;;;;Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;;;------------------------------------------------------------;;;;Arguments:                                                ;;;;lst - list of VLA Layer Objects                           ;;;;------------------------------------------------------------;;(defun LM:ReLockLayers ( lst ) (mapcar '(lambda ( l ) (vla-put-lock l :vlax-true)) lst))

alanjt 发表于 2022-7-6 07:15:16

What's the point of the following? If the DimStyle doesn't exist, I would rather be informed than just have a generic one created. The user will the be forced to overwrite the dimstyle to get their desired/correct one.

(or (tblsearch "DIMSTYLE" DimStyle)   (vla-Add (vla-get-DimStyles doc) DimStyle) )

gstorrie 发表于 2022-7-6 07:18:05

after testing I just noticed that as well, one option that I might want is to set a new dimstyle and all the variables as per our new standards, that way all old dwg's would be updated.
 
Glen

Lee Mac 发表于 2022-7-6 07:18:38

Fair points, I guess this would be better:
 

(defun c:DimUpd ( / *error* _StartUndo _EndUndo DimLayer DimStyle doc lck ss ) (vl-load-com) ;; © Lee Mac 2010 (setq DimLayer "Dims" DimStyle "Standard") (defun *error* ( msg )      (if lck (LM:RelockLayers lck))   (if doc (_EndUndo doc))      (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")       (princ (strcat "\n** Error: " msg " **")))   (princ) ) (defun _StartUndo ( doc ) (_EndUndo doc)   (vla-StartUndoMark doc) ) (defun _EndUndo ( doc )   (if (= 8 (logand 8 (getvar 'UNDOCTL)))   (vla-EndUndoMark doc)   ) ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (tblsearch "LAYER" DimLayer)   (vla-Add (vla-get-Layers doc) DimLayer) ) (if (tblsearch "DIMSTYLE" DimStyle)   (if (ssget "_X" '((0 . "*LEADER,*DIMENSION")))   (progn       (_StartUndo doc) (setq lck (LM:UnlockLayers doc))       (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))         (vl-catch-all-apply         (function             (lambda nil               (mapcar               (function                   (lambda ( p v ) (vlax-put-property obj p v))               )                '(Layer Stylename)               (list DimLayer DimStyle)               )             )         )         )       )       (vla-delete ss)       (LM:RelockLayers lck) (_EndUndo doc)      )   )   (princ "\n--> Dimension Style not Present

alanjt 发表于 2022-7-6 07:23:24

That makes a lot more sense.

Lee Mac 发表于 2022-7-6 07:25:23

 
Excellent

alanjt 发表于 2022-7-6 07:29:39

Just trying to avoid creating issues for the people using this.

Lee Mac 发表于 2022-7-6 07:33:05

 
Good on you.

alanjt 发表于 2022-7-6 07:35:30

Yup.
.......
页: 1 [2]
查看完整版本: Auto-Dimension-Update LISP