Inserting blocks on points

[Lee Mac]

Thanks for your help David - I have learnt a hell of a lot

 

I soon realised with the "or" statements, that they only returned T or nil - and so were obviously a wrong choice (I was trying to achieve a "If not this, then this.." approach, but with less language.) - but all this can be worked around if you just use the entmake with the original text - like you demonstrated - Thanks

 

As for me, after leaving Sixth Form after my A-levels, I worked for a year in a company that used AutoCAD to design tanks and pipework for various processes - it was then that someone introduced me to LISP, and I couldn't believe that it was not in use more in the company as it is such a time-saver. So I started writing it and enjoyed writing it so much that even now, a year later, I have left the company and am at university still writing it.

[Henryjohn]

Wow!!! I'm away for a few days and look what happens. Thanks for everyone who got involved.

 

Lee, I couldn't get your first 2 routines working, maybe something I'm doing wrong.

 

Rustsilo, I beleive these points are just autocad points.

 

 

David, I got your routine working but I'm unsure on a couple of things.

 

1- what is an 'associative list" , how do I create one, where does it live etc.

 

2- can I somehow insert a block (wblock) that is external from the existing drawing, therefore all blocks live outside of the drawings and then call it into the drawing, or does this line do that

((findfile (strcat n ".DWG")) ; See if the block exists in the ACAD library path.

 

3- (setq bl '(("STOP_VALVE" . "BLOCK1")

("WATER_METER" . "BLOCK2")))

I'm assuming that I just keep adding the layer names and the block names to this routine.

As a new comer to lisp routines I found this written by Lee to be great.

 

defun SetBlkTF (n)

(cond ((not (snvalid n)) ; Check the block name for dis-allowed symbols

(princ "\nInvalid Block Name - " n)

(exit)

)

((tblsearch "BLOCK" n)) ; See if the block already exists in the drawing

((findfile (strcat n ".DWG")) ; See if the block exists in the ACAD library path

(command "_.INSERT" n) ; And if it does, create a block definition.

(command)

 

The extra comments in red gives me some indication of what's going on, but i also realise the extra work in typing this in.

 

Thanks again to everone's input

[Lee Mac]

David, I've tried expanding on this new knowledge, but can't seem to work out how to get this to work (only a learning exercise really).

 

(defun c:obj2blk (/ ss ssl bn pt index ent objs elist objlist)

 ; Get Entities

   (while
   (or (not ss)
       (= (setq ssl (sslength ss)) nil)
   ) ;_  end or
      (princ "\nSelect Objects to Convert to Blocks:")
      (setq ss (ssget '((-4 . "<not") (0 . "INSERT") (-4 . "not>"))))
   ) ;_  end while

 ; Get Block Name and Base Point

   (while
   (or (not bn)
       (not (snvalid bn))
   ) ;_  end or
      (setq bn (getstring "Specify Block Name: "))
      (setq pt (getpoint "Specify Base Point for Block: "))
   ) ;_  end while

 ; Create Entity List

   (setq index 0)
   (repeat ssl
   (setq ent (ssname ss index))
   (setq objs (cons ent objs))
   (setq elist (entget ent))
   (setq objlist (cons elist objlist))
   (setq index (1+ index))
   ) ;_  end repeat

 ; Make the Block

   (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))
   (mapcar 'entmake objlist)
   (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

 ; Insert the Block & Delete Originals

   (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
   (mapcar 'entdel objs)
   (redraw)
   (princ)
) ;_  end defun

 

It returns:

 

"Cannot Nest Block Definitions"

[Lee Mac]

Henry, I missed something out in my second one

 

Try this (again, Untested!)

 

(defun c:ptest (/ *error* varLst oldVars oLst ss ssl index file ent elist pt)

   ;;     --- Error Trap ---

   (defun *error* (msg)
   (mapcar 'setvar varLst oldVars)
   (if (= msg "")
       (princ (strcat "\n" (itoa index) " Blocks Inserted."))
       (princ (strcat "\n" (strcase msg)))
   ) ;_  end if
   (princ)
   ) ; end of *error*

   (setq varLst  (list "CMDECHO" "CLAYER")
     oldVars (mapcar 'getvar varLst)
   ) ; end setq 

   ;;     --- Error Trap ---

   (vl-load-com)
   (setvar "cmdecho" 0)

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

   (foreach lay oLst
   (setq ss    (ssget "X"
              (list (cons 0 "POINT")
                (cons 8 lay)
                (cons 410 (getvar "ctab"))
              ) ;_  end list
           ) ;_  end ssget
         ssl   (sslength ss)
         index 0
   ) ;_  end setq
   (if (< 0 ssl 32767)
       (progn
       (sssetfirst nil ss)
       (initget "Yes No")
       (if (/= (getkword (strcat "\nInsert Blocks on Points on Layer " lay "? [Yes/No]: ")) "No")
           (progn
           (if (/=    (setq file (getfiled (strcat "Select a Block for Layer " lay)
                            "C:/"
                            "dwg"
                            8
                      ) ;_  end getfiled
               ) ;_  end setq
               nil
               ) ;_  end /=
               (progn
               (repeat    ssl
                   (setq ent    (ssname ss index)
                     elist    (entget ent)
                     pt    (cdr (assoc 10 elist))
                   ) ;_  end setq
                   (command "-insert" file pt "1" "1" "0")
                   (setq index (1+ index))
                   (entdel ent) ; Remove this Line to keep Point
               ) ;_  end repeat
               ) ;_  end progn
               (alert "No File Selected.")
           ) ;_  end if
           ) ;_  end progn
       ) ;_  end if
       ) ;_  end progn
       (alert "No Points Found.")
   ) ;_  end if
   ) ;_  end foreach
   (*error* "")
   (princ)
) ;_  end defun

[David Bethel]

Hernyjohn,

 

1- what is an 'associative list" , how do I create one, where does it live etc.

 

2- can I somehow insert a block (wblock) that is external from the existing drawing, therefore all blocks live outside of the drawings and then call it into the drawing, or does this line do that

((findfile (strcat n ".DWG")) ; See if the block exists in the ACAD library path.

 

3- (setq bl '(("STOP_VALVE" . "BLOCK1")

("WATER_METER" . "BLOCK2")))

I'm assuming that I just keep adding the layer names and the block names to this routine.

1. bl in Q3 is the associative list. Yes, just keep adding LAYERs and BLOCKs in the ("layer_name" . "block_name") format
   
2. I don't quite understand your reference to ( wblock ) but in short, Yes, the routine will find and use BLOCKs that are external to the dwg as long as they reside in a search path directory.
   
3. See 1

ACAD Help section on association list is a pretty complete and clear for a change. Good Luck. -David

[David Bethel]

Lee,

 

First, let us apologize to Henryjohn for hijacking his thread. But we do seem to be in the same general direction. And he does seem to be interested in AutoLISP.

 

So here it goes Lee, my $0.02

(defun c:obj2blk (/ ss ssl bn pt index ent objs elist objlist)

 ; Get Entities

;;;NO NEED FOR THE ( or ) call
;;;JUST A ( not ) TO ENSURE A PICKSET IS CREATED
;;;(= var nil) IS THE SAME AS A ( not ) CALL
;;;ALSO (sslength ss)  IS A BIT DANGEROUS HERE, IMO
;;;(= (sslength ss) 0) CAN'T HAPPEN HERE, I DON'T THINK

   (while
   (or (not ss)
       (= (setq ssl (sslength ss)) nil)
   ) ;_  end or
      (princ "\nSelect Objects to Convert to Blocks:")
      (setq ss (ssget '((-4 . "<not") (0 . "INSERT") (-4 . "not>"))))
   ) ;_  end while

;;;(- 4 . "<NOT" ) HERE CAN BE REPLACED BY (0 . "~INSERT") FOR SINGLE FILTERS
;;;WHY NO INSERTS?

 ; Get Block Name and Base Point

;;;SEPERATE USER INPUTS INTO INDEPENDANT CALLS

   (while
   (or (not bn)
       (not (snvalid bn))
   ) ;_  end or
      (setq bn (getstring "Specify Block Name: "))
   ) ;_  end while

;;;USE (initget 1) HERE TO FORCE AN INPUT
      (setq pt (getpoint "Specify Base Point for Block: "))


 ; Create Entity List

   (setq index 0)

;;;TRY USING A (while) OR (>) HERE DUE TO (sslength) RETURNING REALS
;;; ON LARGE SETS
   (repeat ssl
   (setq ent (ssname ss index))

;;;USE ( ssadd ) TO MAKE A SET OF ENAMES
   (setq objs (cons ent objs))
   (setq elist (entget ent))
   (setq objlist (cons elist objlist))
   (setq index (1+ index))
   ) ;_  end repeat

 ; Make the Block

   (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))
   (mapcar 'entmake objlist)
   (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;WATCH OUT FOR INSERTS WITH ATTRIB AND POLYLINES ( GROUP 66 = 1)
;;;THEY MUST USE AN ( entnext ) CALL UNTIL THEY REACH A SEQEND ENTITY
;;;(mapcar) WILL MISSS THESE
;;; YOU CANNOT ENTMAKE A VIEWPORT, SO YOU NEED TO FILTER THESE OUT AS WELL

 ; Insert the Block & Delete Originals

   (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
;;;(COMMAND "_.ERASE" ss "")
   (mapcar 'entdel objs)
   (redraw)
   (princ)
) ;_  end defun

And how I rewrote it a bit:

 

(defun c:obj2blk1 (/ ss bn pt i ent elist)

 ; Get Entities

   (while (not ss)
          (princ "\nSelect Objects to Convert to Blocks:")
          (setq ss (ssget '((-4 . "<NOT")(0 . "INSERT,POLYLINE,VIEWPORT")(-4 . "NOT>")))))

 ; Get Block Name and Base Point

   (while (or (not bn)
              (not (snvalid bn)))
          (setq bn (getstring "Specify Block Name: ")))

   (initget 1)
   (setq pt (getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header
   (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET
   (setq i (sslength ss))
   (while (>= i (setq i (1- i)) 0)
          (setq ent (ssname ss i)
                elist (entget ent))
          (entmake elist))

;;;FINISH THE BLOCK DEFINITION
   (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals
   (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
   (command "_.ERASE" ss "")
   (redraw)
   (prin1))

Just as with everything else, the more you code the better you get. And as with everything, else bad habits form early, often and are harder to get rid of as you get older. Regards -David

[Lee Mac]

Thanks a lot David, all your help is much appreciated as always.

 

I think this must be the most that I have learnt from one thread! - I'm sure Henry is learning loads too.

 

I'm glad you pointed out my slip-ups! I see why there is no need for the (or) statement, as, if there is no sslength, there is no ss, so a single NOT is useful.

 

I did not know about the viewports or polyline situation - I just didn't want to make blocks from blocks which is why I excluded inserts.

 

But the point you mention about just the single exclusion filter, do you just replace:

 

(ssget '((-4 . "<not") (0 . "INSERT") (-4 . "not>")))

 

with

 

(ssget '((0 "~INSERT")))

 

Or is it more complicated than that?

 

I am thankful that you have re-written my code, as again, I can learn from your code.

 

Thats a valid point you make about the pickset being large, I just didn't consider one picking 32767 ents!....

 

I like the way you simplify things by creating the block definition, then going through the pickset, before finally ending the block def... much easier than using mapcar.!

 

 

Once again, thanks David - you are a legend.

 

Cheers

 

Lee

[Henryjohn]

Hi Lee I wounder if you remember this posting on inserting block. Here is copy of one of your routines that has work over the months as needed, however I'm hoping you can make a amendment to it.

It apears that if one of the points is not on the drawing the routine stalls

eg if a point associated with sewer_gip is not within the drawing the items after that fail to be inserted.

as I deal with drawings that may have only water components or only sewer components (as well as drawings that have both water and sewer) it would be great if the one routine works for all occasions. Thanks in advance

 

 

(defun c:poi2ins (/ bl olderr ss i en ed nd)

(setq bl '(("water_met" . "water_meter")

("sewer_gip" . "gip")

("water_fp" . "fp")

("sewer_io" . "io")

("sewer_mh" . "mh")

("WATER_val" . "stop_valve")))

(setq olderr *error*

*error* (lambda (e)

(while (> (getvar "CMDACTIVE") 0)

(command))

(and (/= e "quit / exit abort")

(princ (strcat "\nError: " e)))

(prin1)))

(foreach l bl

(cond ((not (setq ss (ssget "X" (list (cons 0 "POINT")

(cons 8 (car l)))))))

((tblsearch "BLOCK" (cdr l)))

((findfile (strcat (cdr l) ".DWG"))

(command "_.INSERT" (cdr l))

(command))

(T

(princ (strcat "\nBlock " (cdr l) " Not Found - "))

(exit)))

(setq i (sslength ss))

(while (not (minusp (setq i (1- i))))

(setq en (ssname ss i)

ed (entget en)

nd (list (cons 2 (cdr l))

(cons 0 "INSERT")))

(foreach g '(6 8 10 39 48 62)

(if (assoc g ed)

(setq nd (cons (cons g (cdr (assoc g ed))) nd))))

(entmake (reverse nd))))

(setq *error* olderr)

(prin1))

[Henryjohn]

Hi Lee

I'm assuming you didn't get this the first time. Are you able to have a look at my previous comment