Auto-Dimension-Update LISP

[Lee Mac]

Hi Guys,

 

This LISP works - sort of.

 

It will produce the desired result, but will return an error in doing so, and I can't work out why.

 

The LISP is supposed to grab all dimensions from all the layers in my template and dump them on a "DIM" layer. Also, update the dimstyle of the dimensions to the STANDARD style as set in my template.

 

I would appreciate any help or advice anyone is willing to provide.

 

(defun c:dimupd (/ oldcmd laylist ss1)
   
   (setq oldcmd (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (if (not (tblsearch "LAYER" "DIM"))
   (command "-layer" "m" "DIM" "C" "2" "DIM" ""))
   (command "-dimstyle" "Restore" "Standard")

   (setq laylist '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
                   "BORDER" "Defpoints" "SIGNATURE" "TEXT"))

   (foreach lay laylist
       (setq ss1 (ssget "X" (list (cons 0 "DIMENSION") (cons 8 lay))))
       (command "_chprop" ss1 "" "LA" "DIM" "")
       (command "-dimstyle" "Apply" ss1 "")
   ) ; end foreach
   (setvar "cmdecho" oldcmd)
   (princ)
)

This is the error I receive upon running the LISP:

 

Type EXIT to return to COMMAND prompt.Unknown command "DIMUPD". Press F1 for

help.

Unknown command "DIMUPD". Press F1 for help.

Unknown command "LA". Press F1 for help.

 

This appears 13 times - i.e. one for each repetition of the foreach command.

[wizman]

(defun c:dimupd	(/ oldcmd laylist ss1)

   (setq oldcmd (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (if	(not (tblsearch "layer" "dim"))
(command "-layer" "m" "dim" "c" "2" "dim" "")
   ) ;_ end_if
   (command "-dimstyle" "restore" "standard")

   (setq laylist '("0"
	    "1"
	    "2"
	    "3"
	    "4"
	    "5"
	    "6"
	    "7"
	    "8"
	    "9"
	    "border"
	    "defpoints"
	    "signature"
	    "text"
	   )
   ) ;_ end_setq

   (foreach lay laylist
(if (setq ss1 (ssget "x" (list (cons 0 "dimension") (cons 8 lay))))
    (progn
	(command "._change" ss1 "" "p" "layer" "dim" "")
	(command "-dimstyle" "apply" ss1 "")
    ) ;_ end_progn
) ;_ end_if
   ) ;_ end_foreach
   (setvar "cmdecho" oldcmd)
   (princ)
) ;_ end_defun

[Lee Mac]

Thanks Wizman,

 

LISP works perfectly - I just added an extra line including storing a variable for the previous current layer, so that when the LISP completed, the user would still remain on the layer he/she was previously working on.

 

But, I can't quite understand why my original LISP did not work - was it the exclusion of the IF function when retrieving the dimensions or was it the use of CHPROP instead of CHANGE?

 

Or was it possibly just a ridiculously stupid typo error?

[wizman]

i was just not used to using 'chprop' leemac, thats why i use the 'change' command. just tested in your original lisp, only wrap the ss1 in an if function like the one i did in my first post and it will also work. Another one you can also add if you want is to check whether dimension style 'standard' exists in your drawing...

 

 

Thanks Wizman,

 

LISP works perfectly - I just added an extra line including storing a variable for the previous current layer, so that when the LISP completed, the user would still remain on the layer he/she was previously working on.

 

But, I can't quite understand why my original LISP did not work - was it the exclusion of the IF function when retrieving the dimensions or was it the use of CHPROP instead of CHANGE?

 

Or was it possibly just a ridiculously stupid typo error?

[Lee Mac]

Ahh, excellent - its good to know that I wasn't far off the mark with my original LISP, thanks for your help Wizman.

 

As for the inclusion of an extra line to check dimstyle existence, would something like the following suffice? :

 

(if (tblsearch "dimstyle" "standard")
   (progn
    ...
   ) ; end progn
   (alert "\nStandard Dimstyle Doesn't Exist.")
) ; end if

[wizman]

Ahh, excellent - its good to know that I wasn't far off the mark with my original LISP, thanks for your help Wizman.

 

As for the inclusion of an extra line to check dimstyle existence, would something like the following suffice? :

 

(if (tblsearch "dimstyle" "standard")
   (progn
    ...
   ) ; end progn
   (alert "\nStandard Dimstyle Doesn't Exist.")
) ; end if

 

 

exactly, that will test if dimstyle>standard is present, youre on the right track, keep up!

[Lee Mac]

Hi Guys,

 

Just thought I'd post the final version, if it is of any use to anyone:

 

;|

   .: Automatic Dimension Updater :.

    .: Function Syntax : DIMUPD :.

        .: by Lee McDonnell :.

   
  (With credit to Wizman & ASMI for help and coding).

|;

(defun GetLayerList ()
   (vl-load-com)
   (vlax-for l 
       (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
       (setq oLst (cons (vla-get-Name l) oLst))
   ); end vlax-for
   (reverse oLst)
); end of GetLayerList

(defun c:dimupd (/ oldcmd oldlay laylist ss1)

   (setq oldcmd (getvar "cmdecho"))
   (setq oldlay (getvar "clayer"))
   (setvar "cmdecho" 0)
   (if (tblsearch "dimstyle" "standard")
       (progn
           (if    (not (tblsearch "layer" "DIM"))
                  (command "-layer" "m" "DIM" "c" "2" "DIM" "")
            ) ; end if
           (command "-dimstyle" "restore" "standard")
           (GetLayerList)
           (foreach lay oLst
               (if (setq ss1 (ssget "x" (list (cons 0 "dimension") (cons 8 lay))))
                   (progn
                       (command "._change" ss1 "" "p" "layer" "DIM" "")
                       (command "-dimstyle" "apply" ss1 "")
                   ) ; end progn
               ) ;  end if
           ) ; end foreach
       ) ; end progn
       (alert "\nStandard Dimstyle Does not Exist.")
   ) ; end if
   (setvar "clayer" oldlay)
   (setvar "cmdecho" oldcmd)
   (princ)
) ; end defun

[Impala62]

How would you add leaders to the code?

I seems to always miss one or two along the way.

 

Bill

[Lee Mac]

Blimey, this is a long time ago - this was one of the first LISP's I wrote

 

Perhaps this:

 

(defun c:dimupd (/ *error* ocm lays ss)

 (defun *error* (msg)
   (if ocm (setvar "CMDECHO" ocm))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 (setq ocm (getvar "CMDECHO")
       lays (vla-get-layers
              (vla-get-ActiveDocument
                (vlax-get-acad-object))))
 (setvar "CMDECHO" 0)
 (or (tblsearch "LAYER" "DIM")
     (vla-put-color
       (vla-add lays "DIM") 2))
 (if (and (tblsearch "DIMSTYLE" "Standard")
          (setq ss (ssget "_X" '((0 . "LEADER,DIMENSION")))))
   (progn
     (command "-dimstyle" "_R" "standard")
     (command "_.chprop" ss "" "_LA" "DIM" "")
     (command "-dimstyle" "_A" ss ""))
   (princ "\n<< No Dimensions Found, or Dimstyle Doesn't Exist >>"))
 (setvar "CMDECHO" ocm)
 (princ))

[gstorrie]

Hi Lee

 

just tried the block update and i works, but it looks like the code makes the "dim" layer, what would be the change to have it set the layer properties if the layer "dim" exists.

 

we are updateing older dwg's and they already may have the right "dim name" but we are wanting to change the dim properties

 

Glen

[Lee Mac]

Hi Lee

 

just tried the block update and i works, but it looks like the code makes the "dim" layer, what would be the change to have it set the layer properties if the layer "dim" exists.

 

we are updateing older dwg's and they already may have the right "dim name" but we are wanting to change the dim properties

 

Glen

 

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]

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

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

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]

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]

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 <--")
 )

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

That makes a lot more sense.

[Lee Mac]

That makes a lot more sense.

 

Excellent

[alanjt]

Excellent

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

[Lee Mac]

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

 

Good on you.

[alanjt]

Good on you.

Yup.

.......