Insertion of block

Hello,

I have made a little lisp here and I want help.

I use DoSLIb which has many advantages.

This is my lisp:

 
(defun c:INBLOCK () 
(setq sl (dos_getdir "Choose Block_Library" "K:\\CAD\\Blocks\\")) (dos_dwgpreview "Choose Block_Library" sl)
(setq p0 (getpoint "\nChoose insertion point: "))
(setvar "attdia" 1)
(command "-insert" sl p0 1 1 0)
(command "attdia" 0 "") 
(princ)
)

How can I insert the chosen block?

It only ask me for insertion, then nothing is inserted.

Thanx for help

Thats solved it:

 

(defun c:AIX:INBLOCK ( / sl)(setq sl nil)
 (setq sl (dos_dwgpreview "Choose block" "K:\\CAD\\Block\\"))
 (if sl (command "-insert" sl pause "1" "1" "0")
   (princ))
 )

I have a little problem...

If I run this:

 
(defun c:INBLOCK ( / sl oldlay)
 (setq oldlay (getvar "clayer"))
 (setq sl nil)
(setvar "cmdecho" 0) 
(if (not (tblsearch "LAYER" "A-------O2-"))
           (command "-layer" "M" "A-------O2-" "C" "red" "A-------O2-" "")
           (setvar "clayer" "A-------O2-")
           ) ; end if
  
(setq sl (dos_getdir "Choose symbols" "K:\\CAD\\Block"))(dos_dwgpreview "Choose symbols" sl)

 (prompt "\nChoose point to insert ...")
 (if sl (command "-insert" sl pause "1" "1" "0")

   (princ))(setvar "clayer" oldlay)
 )

If I cancel the command the layer A-------O2- is created.

What I want is to cancel the command completaly so the lisp exits.

Thanx

The layer creation comes before the program pauses for user input - therefore the layer will be created before the user has a chance to cancel anything

How can I change that ??

So the program cancel layer-creation??

Perhaps use an IF statement with the "choose symbols" section and put the layer creation after that - so that if the user cancels the "choose symbols" part, the layer won't be created.

thanx...

This is what I got:

;;;

(defun C:describe ()
;;;Do the mapcar function for each layer in the drawing.
 (vlax-for layer
       (vla-get-layers
         (vla-get-activedocument
       (vlax-get-acad-object)
       )
         )
;;;if the current layer being checked matches a predetermined name, add the needed description.
   (mapcar
     (function
   (lambda (layname description)
     (if (= (strcase (vla-get-name layer)) (strcase layname))
       (vla-put-description layer description)
       ()
       )
     )
   )
     '("A-------O2-" ) ; This is your list of layers needing a description.
     '("arrow"); This is the descriptions for each layer.  Make sure the order is EXACTLY the same as in the layer list.
     )
   )
 (princ); Silent exit.
 )

   (defun c:layercreation ()

       (if  (tblsearch "LAYER" "A-------O2-")
(command "_layer" "s" "A-------O2-" "")
           (command "-layer" "M" "A-------O2-" "C" "red" "A-------O2-" "")
         
           ) ; end if
         
          );en defun
(defun c:inarrow ( / sl oldlay)
 (setq oldlay (getvar "clayer"))
 (setq sl nil)

  
 (setq sl (dos_dwgpreview "Choose arrows" "K:\\CAD\\\\block\\arrows"))
 (prompt "\nChoose insertion point")
 (if sl
   (progn
     (c:layercreation)
     (c:describe)
     (setvar "clayer" "A-------O2-") 
     (command "-insert" sl pause "1" "1" "0")
   (setvar "clayer" oldlay)

   
);progn

   );if
 (exit)
 
 )

Dos_dwgpreview has a browse button.

I do not know If I can disable it.

The user here has an option to browse to a different folder and choose another block.

if he does that the layer will still be A-------O2-.

What I want if the browse button cant be disabled is if user chooses to go to another path or paths the layer changes to A-------O4- instead.

this I cannot do

I dont know how this can be done .. what is smart.

I have folder:

Block

Under that :

arrow

people

scalesymbols

cars

each of them are layerdependant.

Cars comes in in A-------O1-

People maybe in A-------10-

Above lisp insert an arrow with layer A-------O2- ...

I want if the user changes directory it adept a layer to that directory...

Is it to hard to do?

Thanx

I would define the functions "describe" and "layercreation" as local, i.e.

(defun describe...

instead of

(defun c:describe...

Then invoke them by:

(describe)

instead of

(c:describe)

thanx ..

The path solution ...

Is it possible to do a condition?

Like that this lisp works only in specified paths? And if the user browse to another path not specified in the condition it will alert the user.

I think its more easier...

Is it good approach?

Thank you

I'm not too sure how to word with the "dos" elements of the code

Well ... I dont know if one have to.

Can it be written like:

(cond ((path1)

((path2)

(here goes all the above code))

(t (else alert "dont browse"))

???

I'm not too sure how to word with the "dos" elements of the code

The cad say:

bad function: "K:\\CAD\\Block\\arrow"

I dont know why ...

here is the code I tried...

(defun describe ()
;;;Do the mapcar function for each layer in the drawing.
 (vlax-for layer
       (vla-get-layers
         (vla-get-activedocument
       (vlax-get-acad-object)
       )
         )
;;;if the current layer being checked matches a predetermined name, add the needed description.
   (mapcar
     (function
   (lambda (layname description)
     (if (= (strcase (vla-get-name layer)) (strcase layname))
       (vla-put-description layer description)
       ()
       )
     )
   )
     '("A-------O2-" ) ; This is your list of layers needing a description.
     '("arrow"); This is the descriptions for each layer.  Make sure the order is EXACTLY the same as in the layer list.
     )
   )
 (princ); Silent exit.
 )

   (defun layercreation ()

       (if  (tblsearch "LAYER" "A-------O2-")
(command "_layer" "s" "A-------O2-" "")
           (command "-layer" "M" "A-------O2-" "C" "red" "A-------O2-" "")

           ) ; end if

          );en defun


(defun c:test ( / sl oldlay)
(setq path (strcat "K:\\CAD\\Block\\arrow"))
(cond
 ((path)
  (

 (setq oldlay (getvar "clayer"))
 (setq sl nil)


 (setq sl (dos_dwgpreview "Välj Block" "K:\\CAD\\Block\\arrow"))
 (prompt "\nChoose insertion point...")
 (if sl
   (progn
     (layercreation)
     (describe)
     (setvar "clayer" "A-------O2-") 
     (command "-insert" sl pause "1" "1" "0")
   (setvar "clayer" oldlay)


);progn

   );if
 ))(t (exit)))


 )

au-s

Maybe something like this might be of help

;author	:	jammie
;version 	:	0.0
;date		:	2009-02-12
;posted  : cadtutor.net
;thread : http://www.cadtutor.net/forum/newreply.php?do=newreply&noquote=1&p=212231


(defun c:test (/ laycode lay_name fname oldlay path test)


;laycodes is a list of a drawing paths and layer names. Each list within laycodes is a pair  (<path> <layer name>)
;The first element is the block path. The second element is the layer name associated with the block
;Any blocks found to come from a particular path will be inserted on a preset layer
;
;eg
;("K:\\CAD\\Block\\arrow" 	"A-------O2-")
;A block inserted from "K:\\CAD\\Block\\arrow" will be inserted on layer "A-------O2-"
;
;Note the path is case sensitive

 
(setq laycodes '(
		 ("K:\\CAD\\Block\\arrow" 	"A-------O2-");<-edit this list as required
		 ("K:\\CAD\\Block\\cars" 	"A-------O1-")
		 			 )
      )

 	(if
  ;select the drawing to insert
  (and (setq fname (dos_dwgpreview  "Välj Block" "K:\\CAD\\Block\\"  ".dwg")) (/= fname ""))

  ;if a file has been selected
  (progn

    ;store the current layer
    (setq oldlay   (getvar "clayer"))

    ;retrieve the path
    (setq path     (vl-filename-directory fname))

    (if
        ;check the path against the laycodes
      	(setq test (assoc path laycodes))

      	;if a match is found
      
      	(or

	  ;test if the preset layer exists
	  (tblsearch "layer" (setq lay_name (cadr test)))

	   ;if it does not add it
	  (command "layer" "m" lay_name ""))

      ;if the file does not match the predefined
      
	    (alert
	      (strcat "\n<" (vl-filename-base fname) "> is not from a preset directory"
		      " \nValid directories are :"
		      (apply 'strcat (mapcar '(lambda (x) (strcat "\n\t" (car x))) laycodes))
		      "\nBlock <" (vl-filename-base fname) "> will be inserted on layer <" (getvar "clayer")">")))
      

    
    (and lay_name (setvar "clayer" lay_name))

    (command "-insert" fname pause "1" "1" "0")
    
    (and lay_name  (setvar "clayer" oldlay))
    )

  (alert "\nNo file selected")
  )
 (princ)
 )

Fantastic...

Thanx!!

One more thing ... in the (setq laycodes '(....

Can I also specify color???

Layer A-----EE- goes in in color red

cars in color 140 etc etc ...?

Thanx for help sir.

Your welcome,

I was actually a little intrigued by DOSLIB as I had never heard of it before!

Try the revised version of the code, it only needed a small change.

Just add the preset layer color after layer name in each element of the layercodes

(defun c:test (/ laycode lay_name fname oldlay path test)


;laycodes is a list of a drawing paths, layer names and preset colors.
;Each list within laycodes contains 3 elements  (<path> <layer name> <layer color>)

;The first element is the block path.
;The second element is the layer name associated with the block
;The third item in a list references the layer color
 
;Any blocks found to come from a particular path will be inserted on a preset layer
;If the layer does not exist it will be created and a layer color assigned to ir

;
;eg
;("K:\\CAD\\Block\\arrow" 	"A-------O2-"   1)
;A block inserted from "K:\\CAD\\Block\\arrow" will be inserted on layer "A-------O2-" which has a color 1
;
;Note the path is case sensitive

 
(setq laycodes '(
		 ("K:\\CAD\\Block\\arrow" 	"A-------O2-"  1);<-edit this list as required
		 ("K:\\CAD\\Block\\cars" 	"A-------O1-"  140)
		 			 )
      )

 	(if
  ;select the drawing to insert
  (and (setq fname (dos_dwgpreview  "Välj Block" "K:\\CAD\\Block\\"  ".dwg")) (/= fname ""))

  ;if a file has been selected
  (progn

    ;store the current layer
    (setq oldlay   (getvar "clayer"))

    ;retrieve the path
    (setq path     (vl-filename-directory fname))

    (if
        ;check the path against the laycodes
      	(setq test (assoc path laycodes))

      	;if a match is found
      
      	(or

	  ;test if the preset layer exists
	  (tblsearch "layer" (setq lay_name (cadr test)))

	   ;if it does not add it
	  (and
	    (command "layer" "m" lay_name "")
	    (command "layer" "c" (caddr test) lay_name "" "" );<-line added to change the layer to the required color
	    )
	  )

      ;if the file does not match the predefined
      
	    (alert
	      (strcat "\n<" (vl-filename-base fname) "> is not from a preset directory"
		      " \nValid directories are :"
		      (apply 'strcat (mapcar '(lambda (x) (strcat "\n\t" (car x))) laycodes))
		      "\nBlock <" (vl-filename-base fname) "> will be inserted on layer <" (getvar "clayer")">")))
      

    
    (and lay_name (setvar "clayer" lay_name))

    (command "-insert" fname pause "1" "1" "0")
    
    (and lay_name  (setvar "clayer" oldlay))
    )

  (alert "\nNo file selected")
  )
 (princ)
 )

Also have you consider using tool palettes for inserting your blocks? It will do achieve the same as the above code but with no programming required!

Regards,

Jammie

Yes ...

I was looking into tool palletes.

problem is .. that in this office all architects or 90% of them use 19 inch screens.

With couple of toolpalletes it really require some screen.space.

besides I do not know how they work from a network server.

I tried once and I had bad experiance.

But maybe I did not try enough

Thanx Sir!

Hmm...

It inserts still in color (white)

Yes ...

I was looking into tool palletes.

problem is .. that in this office all architects or 90% of them use 19 inch screens.

With couple of toolpalletes it really require some screen.space.

besides I do not know how they work from a network server.

I tried once and I had bad experiance.

But maybe I did not try enough

 

Thanx Sir!

The palette is just a place holder for the block not a container. You can drag a block from a drawing onto the palette. Then when you drag a block from that palette AutoCAD goes and gets the block definition from the drawing you used to create the block. That is why I have a few drawings in our symbols folder that contain the blocks I want. If I need to update a block it can be done in one drawing that is under my control, not a project specific GA that somebody else could modify. Also my drawing will not get renamed or moved - a real problem to palettes if the source file ceases to exist.

ah its working now ...

I deleted this :

(command "layer" "c" (caddr test) lay_name "" )

and added modified the layercreation line:

 
(command "layer" "m" lay_name "c" (caddr test) lay_name "")