Verify Image exists. Crashes if no image exists.

[jlogan02]

Currently this works if there is an image in the drawing.

(setq Img1 (ssget "x" '((0 . "image"))))
  (if (Tblsearch "Layer" "Image")
    (command "_Layer" "m" "Image" "")
    (command "_chprop" Img1 "" "LA" "Image" "" ""))
    (command "_layer" "S" "Line1" "Freeze" "Image" "")

It doesn't work if there isn't an image in the drawing.
I'm missing something simple, I'm sure.

J. Logan

[BlackBox]

Give this a try:

(vl-load-com)

(defun c:FOO (/ *error* acDoc layerName oLayer ss)

  (defun *error* (msg)
    (if ss
      (vla-delete ss)
    )
    (if acDoc
      (progn
        (vla-endundomark acDoc)
        (vla-regen acDoc acallviewports)
      )
    )
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )

  (if (ssget "_:L" '((0 . "IMAGE") (8 . "~Image")))
    (progn
      (vla-startundomark
        (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
      )

      ;; get or create layer
      (setq oLayer
             (vla-add (vla-get-layers acDoc) (setq layerName "Image"))
      )

      ;; set image layer
      (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
        (vla-put-layer x layerName)
      )

      ;; freeze image layer, set clayer
      (vla-put-freeze oLayer :vlax-true)
      (setvar 'clayer "Line1")
    )
  )

  (*error* nil)
)

Cheers

[jlogan02]

Give this a try:

(vl-load-com)

(defun c:FOO (/ *error* acDoc layerName oLayer ss)

  (defun *error* (msg)
    (if ss
      (vla-delete ss)
    )
    (if acDoc
      (progn
        (vla-endundomark acDoc)
        (vla-regen acDoc acallviewports)
      )
    )
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )

  (if (ssget "_:L" '((0 . "IMAGE") (8 . "~Image")))
    (progn
      (vla-startundomark
        (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
      )

      ;; get or create layer
      (setq oLayer
             (vla-add (vla-get-layers acDoc) (setq layerName "Image"))
      )

      ;; set image layer
      (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
        (vla-put-layer x layerName)
      )

      ;; freeze image layer, set clayer
      (vla-put-freeze oLayer :vlax-true)
      (setvar 'clayer "Line1")
    )
  )

  (*error* nil)
)

Cheers

That works nicely thanks.

I'm getting a select objects prompt to put the .CAL file on the "Image" layer at the end when I run it.

;; freeze image layer, set clayer
      (vla-put-freeze oLayer :vlax-true)
      (setvar 'clayer "Line1")
    )
  )

I'm not terribly fluent here, is this freezing the Image layer once the .CAL file is on the image layer. Or is it supposed to be?

[BlackBox]

Yeah, I was confused by that as well - the last line of your original LISP above, sets "Line1" layer current, then freezes "Image" layer - so I included in my quick adaptation.

If those steps aren't needed (as shown in OP code), just comment them out, or remove them altogether.


Cheers

[jlogan02]

I suppose I should have told the whole story.

I'm going through the process of replacing our old title blocks with an attributed title block. Seems easy enough but someone updated the Title block template so I have to replace the outdated Border and Title block in existing drawings at the same time. Some drawings have .CAL files in them while some don't. I need to protect against erasing the .CAL file when erasing the old Border and Title block via lisp.

Happily the powers that be don't believe in using blocks or object based layer names. So I'm relegated to hunting down each specific entity that is the border and Title block while also preserving the original content within both. the guts if you will. A lot of freezing and thawing going on.

My first move is to see if an image (.CAL file) exists. If so make sure the .CAL image is on the correct layer and freeze the layer to avoid being erased or manipulated during the greater lisp operation and then thawed once the operation is complete. If the .CAL doesn't exist, do nothing and move on. That was what the OP was about. Making sure the .CAL file is preserved during the run of the lisp routine if indeed the .CAL file exists.

Upon further inspection, your addition to my routine is asking for a selection of the .CAL file in a drawing where one doesn't exist. I was trying to make it so the user doesn't have to do anything.

[BlackBox]

No worries, thanks for clarifying.

Up to you on how to proceed - anything I post, you can take and modify how you see fit, no attribution needed.

Now, the code above doesn't test for .CAL file extension, it just handles all images, but it can if you need it to?

Also be mindful, that freezing doesn't prevent deletion, only graphical selection; to prevent deletion, simply lock the layer instead.


If you've got more information that you can post, I can better streamline what I've already posted; just be sure to identify any prudent conditions, or if-then situations, and I'll help where I can.

Cheers

[jlogan02]

Thanks for that BB.

Originally I tried to test if any images existed and if there was an image layer. Then make sure the image was on the image layer and Image layer "Locked". If there isn't an image or an Image Layer, do nothing. I just couldn't seem to get it to work.

I still want to do that without having the user select anything. The routine should run complete without any user input except entering the command to run the routine.

Here's what I have with your code incorporated.

(defun C:ERBDR ( / rev1 REV2 REF1 BD1 BD2 BD3 BD4 BR1 REF1 TB1 TB2 TB3 TB4 BR1 TB5 TR1)
(setvar "cmdecho" 0)
(setvar "osmode" 0)

  (defun *error* (msg)
    (if ss
      (vla-delete ss)
    )
    (if acDoc
      (progn
        (vla-endundomark acDoc)
        (vla-regen acDoc acallviewports)
      )
    )
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )

  (if (ssget "_:L" '((0 . "IMAGE") (8 . "~Image")));;Find any images. Create and set "image" Layer. User prompted to select .CAL file
    (progn
      (vla-startundomark
        (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
	)

      ;; get or create layer
      (setq oLayer
             (vla-add (vla-get-layers acDoc) (setq layerName "Image"))
      )

      ;; set image layer
      (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
        (vla-put-layer x layerName)
      )

      ;; freeze image layer, set clayer
      (vla-put-freeze oLayer :vlax-true)
      (setvar 'clayer "Line1")
    )
  )

  (*error* nil)

(setq rev1 (ssget "_c" '(33.375 21.4375) '(31.875 5.3125))) '((8 . "Line3,Line4,Line5"))

(setq rev2 (ssget "_w" '(31.4375 21.4375) '(31.75 5.3125))) '((8 . "Line3,Line4,Line5"))

(setq ref1 (ssget "_c" '(28.9375 4.9375) '(33.5625 3.3125))) '((8 . "Line3,Line4,Line5"))
	        (command "move" rev1 rev2 ref1 "" "31.75,21.4375" "38.75,21.4375");;move reference drawing #'s and revision text/lines out of old border
(setq bd1
	(ssget "_c" '(0 0) '(1.5 23.1875))) '((8 . "Line0,Line3,Line4,Line5"));;erase White Border and left magenta line, text and triangles.
		(command "erase" bd1 "")
(setq bd2
       (ssget "_c" '(0 0) '(35 0.25))) '((8 . "Line0,Line3,Line4,Line5"));;erase Bottom magenta line, text and triangles.
	       	(command "erase" bd2 "")

(setq bd3
       (ssget "W" '(35 0.25) '(33.625 22.5))) '((8 . "Line0,Line3,Line4,Line5"));;erase Right magenta line, text and triangles.
		(command "_layer" "Freeze" "Text0,Text1,Text5" "")
  	       	(command "erase" bd3 "")

(setq bd4 (ssget "_c" '(33.625 22.5) '(1.5 21.75))) '((8 . "Line0,Line3,Line4,Line5"));;erase Top magenta line, text and triangles.

(setq br1 (ssget "_c" '(32.125 21.625) '(33.375 21.5625)))
  		(command "erase" bd4 br1 "")
(setq tb1
       (ssget "_c" '(28.8750 0.25) '(28.375 5.0)));;erase Revision #s/REV & Lines
		(command "erase" tb1 "")
(setq tb2
       (ssget "_c" '(28.875 1.6875) '(29.0625 0.25)));;erase Initial Text, Scale
  		(command "erase" tb2 "")
(setq tb3
       (ssget "_W" '(29.5 1.3125) '(31.875 0.625)));;erase Scale, Approved, 21D-
  		(command "erase" tb3 "")
(setq tb4 (ssget "_c" '(33 0.625) '(32.0 0.625)))

(setq tr1 (ssget "_c" '(31.875 5.125) '(30.125 5.1875)));;Erase horizontal line above Sht number and Subject code
  		(command "erase" tb4 tr1 "")
(setq tb5
       (ssget "_c" '(33.5625 2.9375) '(33.5625 1.6875)))
		(command "-layer" "thaw" "Image,Text0,Text1,Text5,Line5" "")
  		(command "_insert" "21_CTL_SDH_ATT.DWG" "0,0" "1" "1" "0" "");;Insert new Attributed TB
  		(command "Explode" "Last" "")
  		(command "move" ref1 rev1 rev2 "" "38.75,21.4375" "31.75,21.4375" "");;move Reference drawing #'s and Revision text/lines back
  
  (setvar "cmdecho" 1)
  (setvar "osmode" 1)
  (princ)
)

[BlackBox]

Without a data set to test this against, give this quick adaptation a try (untested):

(vl-load-com)

(defun c:ERBDR (/ *error* acDoc clayer cmdecho nomutt osmode layerName
                  oLayer ssImage rev1 rev2 ref1 bd1 bd2 bd3 bd4 br1 tb1
                  tb2 tb3 tb4 tr1 tr1 tb5
                 )
  (princ "\rERBDR ")

  (defun *error* (msg)
    (if osmode
      (setvar 'osmode osmode)
    )
    (if nomutt
      (setvar 'nomutt nomutt)
    )
    (if cmdecho
      (setvar 'cmdecho cmdecho)
    )
    (if clayer
      (setvar 'clayer clayer)
    )
    (if ssImage
      (vla-delete ssImage)
    )
    (if acDoc
      (vla-endundomark acDoc)
    )
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )
  
  ;; start undomark
  (vla-startundomark
    (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
  )
  (princ "\nWorking, please wait... ")
  (princ)
  
  ;; store sysvars
  (setq clayer (getvar 'clayer))
  (setq cmdecho (getvar 'cmdecho))
  (setq nomutt (getvar 'nomutt))
  (setq osmode (getvar 'osmode))

  ;; set sysvars
  (setvar 'clayer "Line1")
  (setvar 'cmdecho 0)
  (setvar 'nomutt 1)
  (setvar 'osmode 0)

  ;; get or create image layer
  (setq oLayer
         (vla-add (vla-get-layers acDoc) (setq layerName "Image"))
  )

  ;; if images are found on non-image layers
  (if (ssget "_x" '((0 . "IMAGE") (8 . "~Image")))
    (progn

      ;; put image(s) on image layer
      (vlax-for x (setq ssImage (vla-get-activeselectionset acDoc))
        (vla-put-layer x layerName)
      )
    )
  )

  ;; lock image layer
  (vla-put-lock oLayer :vlax-true)

  ;; move reference drawing #'s and revision text/lines out of old border
  (setq rev1 (ssget "_c"
                       '(33.375 21.4375)
                       '(31.875 5.3125)
                       '((8 . "Line3,Line4,Line5"))
                )
      )
  (setq rev2 (ssget "_w"
                       '(31.4375 21.4375)
                       '(31.75 5.3125)
                       '((8 . "Line3,Line4,Line5"))
                )

      )
  (setq ref1 (ssget "_c"
                       '(28.9375 4.9375)
                       '(33.5625 3.3125)
                       '((8 . "Line3,Line4,Line5"))
                )
      )
  
  (command "._move" rev1 rev2 ref1 "" "31.75,21.4375" "38.75,21.4375")

  ;; erase whitebBorder and left magenta line, text and triangles.
  (setq bd1 (ssget "_c"
                       '(0 0)
                       '(1.5 23.1875)
                       '((8 . "Line0,Line3,Line4,Line5"))
                )
      )

  ;; erase bottom magenta line, text and triangles.
  (setq bd2
             (ssget "_c"
                    '(0 0)
                    '(35 0.25)
                    '((8 . "Line0,Line3,Line4,Line5"))
             )
      )

  ;; erase right magenta line, text and triangles.
  (setq bd3
             (ssget "W"
                    '(35 0.25)
                    '(33.625 22.5)
                    '((8 . "Line0,Line3,Line4,Line5"))
             )
      )
  (command "._erase" bd1 bd2 bd3 "")

  (command "._-layer" "_f" "Text0,Text1,Text5" "")

  ;; erase top magenta line, text and triangles.
  (setq bd4 (ssget "_c"
                       '(33.625 22.5)
                       '(1.5 21.75)
                       '((8 . "Line0,Line3,Line4,Line5"))
                )
      )

  (setq br1 (ssget "_c" '(32.125 21.625) '(33.375 21.5625)))

  ;; erase revision #s/REV & lines
  (setq tb1 (ssget "_c" '(28.8750 0.25) '(28.375 5.0)))

  ;; erase initial text, scale
  (setq tb2 (ssget "_c" '(28.875 1.6875) '(29.0625 0.25)))

  ;; erase scale, approved, 21D-
  (setq tb3 (ssget "_W" '(29.5 1.3125) '(31.875 0.625)))

  (setq tb4 (ssget "_c" '(33 0.625) '(32.0 0.625)))

  ;; erase horizontal line above Sht number and subject code
  (setq tr1 (ssget "_c" '(31.875 5.125) '(30.125 5.1875)))

  (setq tb5 (ssget "_c" '(33.5625 2.9375) '(33.5625 1.6875)))

  (command "._erase" bd4 br1 tb1 tb2 tb3 tb4 tr1 tr1 tb5 "")

  (command "._-layer" "_t" "Image,Text0,Text1,Text5,Line5" "")

  ;; insert new attributed title block
  (command "._insert" "21_CTL_SDH_ATT.DWG" "0,0" "1" "1" "0" "")
  (command "._explode" "_l" "")

  ;; move reference drawing #'s and revision text/lines back
  (command "._move" rev1 rev2 ref1 "" "38.75,21.4375" "31.75,21.4375" "")

  (*error* nil)
)

Cheers

[jlogan02]

This works very well BB. There's obviously a speed difference between your updated code and my OP version. Or even my version with your earlier go at it. I'm assuming that's because your approach is a little easier on memory.

I've been getting this error message since day one with this build..Minus the "Please Wait" portion obviously.

This is new though...

Unit-scaling error (eWasErased)Unknown command "ERBDR".  Press F1 for help. 
----------------------------

Command: (LOAD "H:/Catch/CAD stuff/Att TB setup/Support/NoRaster.LSP") C:ERBDR

Command: ERBDR
ERBDR
Working, please wait... Unknown command "ERBDR".  Press F1 for help.
Unknown command "75,21.4375".  Press F1 for help. -- 
Unknown command "75,21.4375".  Press F1 for help.

Unit-scaling error (eWasErased)Unknown command "ERBDR".  Press F1 for help.
Unknown command "ERBDR".  Press F1 for help.
Unknown command "ERBDR".  Press F1 for help.
Unknown command "75,21.4375".  Press F1 for help.
Unknown command "75,21.4375".  Press F1 for help.
Unknown command "ERBDR".  Press F1 for help.

----------------------

This seems to be at my first move where the Crossing points are listed at setq's Rev1, Rev2. (.75,21.4375) also occurs later in the second move of these objects at the bottom of the routine.

  ;; move reference drawing #'s and revision text/lines out of old border
  (setq rev1 (ssget "_c"
                       '(33.375 21.4375)
                       '(31.875 5.3125)
                       '((8 . "Line3,Line4,Line5"))
                )
      )
---------------------

When I started encountering these I set breakpoints but they never seemed to trigger. I'll try to step through line by line and see what that brings unless you see something obvious. It'll be a learning experience anyway.

Appreciate your help on this. I like how it doesn't seem to chug like the OP did.

J. Logan

[BlackBox]

You're welcome.

The speed difference comes from simply combining Command calls where I could... The more Command calls the more time it takes.

To try and help it make sense to your original intent, I kept the multiple selection sets and Command calls; to speed it up more, I'd personally have gone with Visual LISP's (ActiveX) Methods instead.


Let me know what you find when you step through the code, as that is my stab in the dark.

Cheers