defun to create or update layers not updating them

[3dwannab]

Hi all,

 

I have a program to create circles from one point. It basically helps to draw a survey from running dimensions by entering all those and this spits circles out to those dims.

 

There's a defun I got to create and update layers. The only thing I've added to that is adding a layer description. Here's where I get the defun (It's from @ronjonp ).

 

It this some sort of localisation issue?

 

Anyway, here's my full program below.

 

PROBLEM:

If I change the layer properties (color, linetype or description) the defun doesn't update them when I run my program.

 

(vl-load-com)

(defun c:--LDSurvey_Circles ( / ) (progn (LOAD "3dwannab_Survey_Circles")))

;; -----------------------=={ Survey_Circles }==--------------------------
;; -----------------------------------------------------------------------

;; AUTHOR & ADDITIONAL CODE
;; Author: 3dwannab, Copyright © 2022
;; Credit to ronjonp for the function to create or update layers.

;; ABOUT / NOTES
;; - Creates a set of circles from one chosen point.
;; - Creates a named layer that is coloured, DASHED and doesn't plot with a
;;   layer description.
;; - This is handy for when you are drawing a survey and you have the survey in
;;   running dimensions.
;; - Can also be useful for drawing an inner and outer circle, like a Donut.
;;   Which is unlike the AutoCAD command that creates a thick arced Polyline.

;; USAGE
;; - Fist prompt with ask for the location for all the circles.
;; - Then a prompt will show to enter each of the circles radius' separated by a
;;   space.
;; - For example. Entering '100 200 555' will create 3 circles with those three
;;   circles in the string.

;; FUNCTION SYNTAX
;; Short-cut        CIRS
;; Long-cut         Survey_Circles

;; VERSION          DATE          INFO
;; Version 1.0      26-08-2022    First written

;; TO DO LIST
;; - BUG - Where the layer exists and it changed. Running this program will not
;;   update it.

;; -----------------------------------------------------------------------
;; -----------------------=={ Survey_Circles }==--------------------------

(defun c:CIRS nil (c:Survey_Circles))

(defun c:Survey_Circles ( /
  *error*
  acDoc
  cirRadiuses
  cirRadiusesStr
  layName
  ptCircle
  r
  )

(defun *error* (errmsg)
  (and acDoc (vla-EndUndoMark acDoc))
  (and errmsg
   (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
   (princ (strcat "\n<< Error: " errmsg " >>\n"))
   )
  (vla-StartUndoMark (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (princ)
  )

(princ "'CIRS' or 'Survey_Circles' command ran..\n")

;; Start the undo mark here
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

;; Set up variables
(setq ptCircle (getpoint "Pick a point for the survey circles : "))
(setq cirRadiusesStr (getstring T "Enter the radiuses here separated by spaces : "))

;; Split the string into a list
(setq cirRadiuses (splitStr cirRadiusesStr " " " "))

;; Make a new layer that is green, DASHED and doesn't plot with description
(setq layName "Survey Circles")
(_addOrUpdateLayer layName 100 "DASHED" 0 "Temp layer for survey circles")

;; Loop the cirRadiuses variable
(foreach r cirRadiuses
 (progn
  (entmake
    (list
      '(0 . "circle")
      (cons 8 layName)
      (cons 10 ptCircle)
      (cons 40 r)
      )
    )
  )
 )

(vla-EndUndoMark acDoc)

(*error* nil) (princ)

)

(princ)

;; Help with splitting a string https://www.cadtutor.net/forum/topic/66221-how-to-split-a-string-by-character/?do=findComment&comment=543913
;; str = Input String, d = Delimiter, s = Character to use as the splitter
(defun splitStr ( str d s / )
  (read (strcat "("(vl-string-translate d s str)")"))
  )

;; Creates a new layer or updates an existing one if it exists.
;; Will attempt to load the linetype if found in the acad*.lin file and if the layer exists, it will update the properties.
;; Code by ronjonp, taken from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-layer-with-true-color-in-lisp/m-p/7904814#M367339
;; Usage:
;; (_addOrUpdateLayer "NewLayerName" '(69 69 69) "3Dash2" 1 "Description goes here")
;; (_addOrUpdateLayer "NewLayerName2" 169 "3Dash2" 0 "Description goes here")
;; NOTE:
;; The 0 or 1 in examples above is for plot on = 1 or plot off = 0.
;; Modified by 3dwannab on 2022.06.11 to add description to the function.
(defun _addOrUpdateLayer (name color ltype plot desc / _loadlinetype _rgb _setLayDescription d e)
  ;; RJP - 04.03.2018
  ;; Creates or updates a layer
  (defun _rgb (l) (+ (lsh (fix (car l)) 16) (lsh (fix (cadr l)) 8) (fix (caddr l))))
  (defun _loadlinetype (linetype / lt out)
    (cond ((tblobjname "ltype" linetype) t)
      ((setq lt (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))))
       (setq out (vl-catch-all-apply
         'vla-load
         (list lt
           linetype
           (findfile (if (= 0 (getvar 'measurement))
             "acad.lin"
             "acadiso.lin"
             )
           )
           )
         )
       )
       (not (vl-catch-all-error-p out))
       )
      )
    )
  ;; _setLayDescription added by 3dwannab on 2022.06.11
  (defun _setLayDescription ( name desc / )
    (setq layerobj (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) name))
    (vla-put-description layerobj desc)
    )
  (setq d (apply 'append
   (list (if (setq e (tblobjname "layer" name))
     (entget e '("*"))
     (list '(0 . "LAYER")
       '(100 . "AcDbSymbolTableRecord")
       '(100 . "AcDbLayerTableRecord")
       '(70 . 0)
       )
     )
   (list (cons 2 name)
     (if (listp color)
       (cons 420 (_rgb color))
       (cons 62 color)
       )
     (cons 6
       (if (_loadlinetype ltype)
         ltype
         "continuous"
         )
       )
     (cons 290 plot) ;; 1 = plottable 0 = not=plottable
     )
   )
   )
  )
  (if e
    (entmod d)
    (entmakex d)
    )

  (if name
    (_setLayDescription name desc)
    )

  )

(princ (strcat "\n3dwannab_Survey_Circles.lsp Loaded. Invoke by typing 'CIRS' or 'Survey_Circles'")) (princ)

;; (c:Survey_Circles) ;; Uncomment for quick testing only

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

Edited June 12, 2022 by 3dwannab

[mhupp]

the problem is you need to add an if statement checking if layer exists.  because

(_addOrUpdateLayer layName 100 "DASHED" 0 "Temp layer for survey circles")

Is "updating" any changes you made back to these settings when you run the lisp.

 

 

change the following.

;; Make a new layer that is green, DASHED and doesn't plot with description
(setq layName "Survey Circles")
(_addOrUpdateLayer layName 100 "DASHED" 0 "Temp layer for survey circles")
;; Loop the cirRadiuses variable  

update to

;; Make a new layer that is green, DASHED and doesn't plot with description
(if (tblsearch "LAYER" "Survey Circles")
  (progn) ;if existing do nothing aka keep any changes you made
  (_addOrUpdateLayer "Survey Circles" 100 "DASHED" 0 "Temp layer for survey circles") ;only adds layer doesn't "update"
)
;; Loop the cirRadiuses variable

 

Edited June 13, 2022 by mhupp

[3dwannab]

Thanks mhupp, I want _addOrUpdateLayer to work regardless or whether or not the layer exists as I want to update the properties if the layer exists.

 

Trouble is it's not doing so when I wrap it in my program.

 

It does work when _addOrUpdateLayer is loaded as it's own defun though.

[mhupp]

Sorry I misunderstood. rather then building an entget list and using entmod. I just used vla-put to update layer if existing. entmakex if not existing.

 

;; Creates a new layer or updates an existing one if it exists.
;; Will attempt to load the linetype if found in the acad*.lin file and if the layer exists, it will update the properties.
;; Code by ronjonp, taken from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-layer-with-true-color-in-lisp/m-p/7904814#M367339
;; Usage:
;; (_addOrUpdateLayer "NewLayerName" '(69 69 69) "3Dash2" 1 "Description goes here")
;; (_addOrUpdateLayer "NewLayerName2" 169 "3Dash2" 0 "Description goes here")
;; NOTE:
;; The 0 or 1 in examples above is for plot on = 1 or plot off = 0.
;; Modified by 3dwannab on 2022.06.11 to add description to the function.
(defun _addOrUpdateLayer (name color ltype plot desc / _loadlinetype _rgb _setLayDescription d e)
  ;; RJP - 04.03.2018
  ;; Creates or updates a layer
  (defun _rgb (l) (+ (lsh (fix (car l)) 16) (lsh (fix (cadr l)) 8) (fix (caddr l))))
  (defun _loadlinetype (linetype / lt out)
    (cond
      ((tblobjname "ltype" linetype) t)
      ((setq lt (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))))
             (setq out (vl-catch-all-apply
                         'vla-load
                         (list lt
                               linetype
                           (findfile (if (= 0 (getvar 'measurement))
                                       "acad.lin"
                                       "acadiso.lin"
                                     )
                           )
                         )
                       )
             )
        (not (vl-catch-all-error-p out))
      )
    )
  )
  (if (tblsearch "layer" name)
    (progn
      (setq layerobj (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) name))
      (vla-put-Color layerobj color)
      (vla-put-linetype layerobj (if (_loadlinetype ltype) ltype "continuous"))
      (cond
        ((eq plot 0)
             (vla-put-plottable layerobj :vlax-false)
        )
        ((eq plot 1)
             (vla-put-plottable layerobj :vlax-true)
        )
      )
      (vla-put-description layerobj desc)
    )
    (entmakex (list '(0 . "LAYER")
                    '(100 . "AcDbSymbolTableRecord")
                    '(100 . "AcDbLayerTableRecord")
                    '(70 . 0)
                    (cons 2 name)
                    (if (listp color)
                      (cons 420 (_rgb color))
                      (cons 62 color)
                    )
                    (cons 6
                      (if (tblsearch "ltype" ltype)
                        ltype
                        "continuous"
                      )
                    )
                    (cons 290 plot)
                    ;;1 = plottable 0 = not=plottable
              )
    )
  )
)

 

maybe @ronjonp can explain/fix the entmod.

 

 

Edited June 13, 2022 by mhupp

[3dwannab]

Thanks, I guess I should have used that as I didn't quite understand the original code.

 

Here's the working version now:

(vl-load-com)

(defun c:--LDSurvey_Circles ( / ) (progn (LOAD "3dwannab_Survey_Circles")))

;; -----------------------=={ Survey_Circles }==--------------------------
;; -----------------------------------------------------------------------

;; AUTHOR & ADDITIONAL CODE
;; Author: 3dwannab, Copyright © 2022
;; Credit to ronjonp for the function to create or update layers.

;; ABOUT / NOTES
;; - Creates a set of circles from one chosen point.
;; - Creates a named layer that is coloured, DASHED and doesn't plot with a
;;   layer description.
;; - This is handy for when you are drawing a survey and you have the survey in
;;   running dimensions.
;; - Can also be useful for drawing an inner and outer circle, like a Donut.
;;   Which is unlike the AutoCAD command that creates a thick arced Polyline.

;; USAGE
;; - Fist prompt with ask for the location for all the circles.
;; - Then a prompt will show to enter each of the circles radius' separated by a
;;   space.
;; - For example. Entering '100 200 555' will create 3 circles with those three
;;   circles in the string.

;; FUNCTION SYNTAX
;; Short-cut        CIRS
;; Long-cut         Survey_Circles

;; VERSION          DATE          INFO
;; Version 1.0      2022.06.14    First written

;; TO DO LIST
;; - NA

;; -----------------------------------------------------------------------
;; -----------------------=={ Survey_Circles }==--------------------------

(defun c:CIRS nil (c:Survey_Circles))

(defun c:Survey_Circles ( /
  *error*
  acDoc
  cirRadiuses
  cirRadiusesStr
  layName
  ptCircle
  r
  )

(defun *error* (errmsg)
  (and acDoc (vla-EndUndoMark acDoc))
  (and errmsg
   (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
   (princ (strcat "\n<< Error: " errmsg " >>\n"))
   )
  (vla-StartUndoMark (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (princ)
  )

(princ "'CIRS' or 'Survey_Circles' command ran..\n")

;; Start the undo mark here
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

;; Set up variables
(setq ptCircle (getpoint "Pick a point for the survey circles : "))
(setq cirRadiusesStr (getstring T "Enter the radiuses here separated by spaces : "))

;; Split the string into a list
(setq cirRadiuses (splitStr cirRadiusesStr " " " "))

;; Make a new layer that is green, DASHED and doesn't plot with description
(setq layName "Survey Circles")
(_addOrUpdateLayer layName 100 "DASHED" 0 "Temp layer for survey circles")
;; (_addOrUpdateLayer layName 100 "DASHED" 0)

;; Loop the cirRadiuses variable
(foreach r cirRadiuses
 (progn
  (entmake
    (list
      '(0 . "circle")
      (cons 8 layName)
      (cons 10 ptCircle)
      (cons 40 r)
      )
    )
  )
 )

(vla-EndUndoMark acDoc)

(*error* nil) (princ)

)

(princ)

;; Help with splitting a string https://www.cadtutor.net/forum/topic/66221-how-to-split-a-string-by-character/?do=findComment&comment=543913
;; str = Input String, d = Delimiter, s = Character to use as the splitter
(defun splitStr ( str d s / )
  (read (strcat "("(vl-string-translate d s str)")"))
  )

;; Creates a new layer or updates an existing one if it exists.
;; Will attempt to load the linetype if found in the acad*.lin file and if the layer exists, it will update the properties.
;; Code by ronjonp, taken from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-layer-with-true-color-in-lisp/m-p/7904814#M367339
;; Usage:
;; (_addOrUpdateLayer "NewLayerName" '(69 69 69) "3Dash2" 1 "Description goes here")
;; (_addOrUpdateLayer "NewLayerName2" 169 "3Dash2" 0 "Description goes here")
;; NOTE:
;; The 0 or 1 in examples above is for plot on = 1 or plot off = 0.
;; Modified by 3dwannab on 2022.06.11 to add description to the function.
;; Help from mhupp here to get it to update layer if it exists: https://www.cadtutor.net/forum/topic/75414-defun-to-create-or-update-layers-not-updating-them/?do=findComment&comment=596266
(defun _addOrUpdateLayer (name color ltype plot desc / _loadlinetype _rgb _setLayDescription d e)
  ;; RJP - 04.03.2018
  ;; Creates or updates a layer
  (defun _rgb (l) (+ (lsh (fix (car l)) 16) (lsh (fix (cadr l)) 8) (fix (caddr l))))
  (defun _loadlinetype (linetype / lt out)
    (cond
      ((tblobjname "ltype" linetype) t)
      ((setq lt (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object))))
       (setq out (vl-catch-all-apply
         'vla-load
         (list lt
           linetype
           (findfile (if (= 0 (getvar 'measurement))
             "acad.lin"
             "acadiso.lin"
             )
           )
           )
         )
       )
       (not (vl-catch-all-error-p out))
       )
      )
    )
  (if (tblsearch "layer" name)
    (progn
      (setq layerobj (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) name))
      (vla-put-Color layerobj color)
      (vla-put-linetype layerobj (if (_loadlinetype ltype) ltype "continuous"))
      (cond
        ((eq plot 0)
         (vla-put-plottable layerobj :vlax-false)
         )
        ((eq plot 1)
         (vla-put-plottable layerobj :vlax-true)
         )
        )
      (vla-put-description layerobj desc)
      )
    (entmakex (list '(0 . "LAYER")
      '(100 . "AcDbSymbolTableRecord")
      '(100 . "AcDbLayerTableRecord")
      '(70 . 0)
      (cons 2 name)
      (if (listp color)
        (cons 420 (_rgb color))
        (cons 62 color)
        )
      (cons 6
        (if (tblsearch "ltype" ltype)
          ltype
          "continuous"
          )
        )
      (cons 290 plot) ;; 1 = plottable 0 = not plottable
      )
    )
    )
  )

;; (_addlayer "NewLayerName3" '(89 88 88) "Hidden2" 1)
;; (_addlayer "NewLayerName3" 7 "Foo" 0)

(princ (strcat "\n3dwannab_Survey_Circles.lsp Loaded. Invoke by typing 'CIRS' or 'Survey_Circles'")) (princ)

;; (c:Survey_Circles) ;; Uncomment for quick testing only

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

Edited June 14, 2022 by 3dwannab