Auto-Dimension-Update LISP

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:

copy

(defun c:DimUpd ( / *error* _StartUndo _EndUndo DimLayer DimStyle doc lck ss ) (vl-load-com) ;; © Lee Mac 2010 [color=red][b](setq DimLayer "Dims" DimStyle "Standard")[/b][/color] (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.

copy

  (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:

[code](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