Autocad open source drawing of selected bloc

Hello everybody,

I have a lisp "Open-BL" that open a block from anywhere, the sub-directories are specified in a special text file. This Lisp routine work well but a want to open a selected block on a drawing with hundred of block. I modified "Open-BL" to "NewOpen-BL" but it dosent work and I don't know why!!!

Any help is appreciated.

NewOpen-BL.LSP

Open-BL.LSP

test.txt

Your code should work if the block is available as a DWG file in a folder from Support File Search Path list or contained in your paths list (test.txt file). It will fail if you select an entity other than a block (see below).

What error message you received?

It seems that you attempted to validate user's selection, but you should use that into an IF statement:

(if (eq (cdr (assoc 0 (entget ent))) "INSERT")
(progn
  ...
)
)

Alternatively check the SSGET function:

(if (setq ssetBlock (ssget "_:S:E" '((0 . "INSERT"))))
(print (vla-get-effectivename (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname ssetBlock 0)))))))
)

Please also pay attention that "LIST" is a reserved symbol; you may want to consider renaming that variable.

Thank you for your response,

I mofified the Lisp, but I get this message:

Select Block Entity:

I can't find EP1780.DWG anywhere!

nil

Lisp modification:

(setq ent (car (entsel "\nSelect Block Entity: ")))
                (if  (eq (cdr (assoc 0 (entget ent))) "INSERT")
                 (progn
                 (setq BLKN (vla-get-effectivename
                                       (vlax-ename->vla-object ent)))
                 )
                 )

That meens that selected blcok isn't available as DWG file, at least not on the investigated paths (that it, the ones in Support File Search Path list and test.txt file).

If you modified the code like above, then should also validate the existace of block name:

...
(if (and [color=red]BLKN[/color] (/= BLKN "") (/= BLKN "?"))
...

Please edit your previous post and add code tags.

Many thank, it works.....

You're welcome!

Please edit your previous post and the add code tags.

Hello

What you mean with : Please edit your previous post and the add code tags.

In order to have the code well presented and preserve its formattings it must be wrapped in

 tags. My previous post contains a link where you will find information how to do this.

Here the Lisp :

(defun C:NewOpen-BL ( / POINTER FolderList BLKN PATH SUBDIR)
  (setq POINTER "H:")
  (setq FolderList (open (strcat pointer "[url="file://\\test.txt"]\\test.txt[/url]") "r"))
(setq ent (car (entsel "\nSelect Block Entity: ")))
                (if  (eq (cdr (assoc 0 (entget ent))) "INSERT")
                 (progn
                 (setq BLKN (vla-get-effectivename
                                       (vlax-ename->vla-object ent)))
                 )
                 )
  (if (= BLKN "") (princ "\n*Invalid*\n"))
  (if (= BLKN "?") (command ".insert" "?"))
  (if (and BLKN (/= BLKN "") (/= BLKN "?"))
     (progn
        (setq BLKN (strcase (strcat BLKN ".DWG"))
           PATH (findfile blkn)
           SUBDIR (read-line FolderList)
        )
        (while (and SUBDIR (not PATH))
           (setq   PATH (findfile (strcat SUBDIR "\\" BLKN))
              SUBDIR (read-line FolderList)
        ))
        (if (= PATH nil)
           (prompt (strcat "\nI can't find " BLKN " anywhere!\n"))
           (progn
(if (= 0 (getvar "SDI"))
(vla-activate (vla-open (vla-get-documents (vlax-get-acad-object)) path))
(vla-sendcommand
(vla-get-activedocument
(vlax-get-acad-object))
(strcat "(command \"_.open\")\n" path "\n") )
)
           )
        )
     )
  )
  (close FolderList)
);

Example of txt Datei:

H:\BLOC\profile
H:\BLOC\gomme

I need one time more your help, I want to redefine the block opened with the previous Lisp. I create a new Lisp "InsertBL" and replaced the open command with the insert command. The lisp works but it doesnt redefine the block!!! You know why?

(defun C:InsertBL ( / POINTER FolderList BLKN PATH SUBDIR)
  (setq POINTER "H:")
  (setq FolderList (open (strcat pointer "[url="file://\\test.txt"]\\test.txt[/url]") "r"))
(setq ent (car (entsel "\nSelect Block Entity: ")))
                (if  (eq (cdr (assoc 0 (entget ent))) "INSERT")
                 (progn
                 (setq BLKN (vla-get-effectivename
                                       (vlax-ename->vla-object ent)))
                 )
                 )
  (if (= BLKN "") (princ "\n*Invalid*\n"))
  (if (= BLKN "?") (command ".insert" "?"))
  (if (and BLKN (/= BLKN "") (/= BLKN "?"))
     (progn
        (setq BLKN (strcase (strcat BLKN ".DWG"))
           PATH (findfile blkn)
           SUBDIR (read-line FolderList)
        )
        (while (and SUBDIR (not PATH))
           (setq   PATH (findfile (strcat SUBDIR "\\" BLKN))
              SUBDIR (read-line FolderList)
        ))
        (if (= PATH nil)
           (prompt (strcat "\nI can't find " BLKN " anywhere!\n"))
           (progn
              (command "._-insert" path pause "1" "1" pause)
           )
        )
     )
  )
  (close FolderList)
);

I found an oder way without txt Datei, On the lisp I've add 2 functions, one for block opening and the second for redefining a block.

(defun partsearch (n /)
(cond
((findfile n)) ;;; first search the dir's in AutoCAD's "env" variable, then search the additional places listed below:
((findfile (strcat "H:/bloc/profile/" n))) ;;;<--- this is an example path
((findfile (strcat "H:/bloc/gomme/" n)));;;<--- this is another example path
;;; etc, etc. List as many block folder 
;;; paths as you need, following the patterns
(t (progn
(prompt 
(strcat "** PartSearch Error ** Required file (" n ") could not be found."))
(terpri)
)
)
)
);defun
;;; ----------- Open source drawing of selected Block--------------
(defun c:OpenBL ( / cmdecho regen n bpath)
(setq cmdecho (getvar "cmdecho"))
(setq regen (getvar "regenmode"))
(setvar "cmdecho" 0)
(setvar "regenmode" 0)
(setq ent (car (entsel "\nSelect Block Entity: ")))
                (if  (eq (cdr (assoc 0 (entget ent))) "INSERT")
                 (progn
                 (setq BLKN (vla-get-effectivename
                                       (vlax-ename->vla-object ent)))
                 )
                 )
(setq bpath (partsearch (strcat blkn ".dwg")))
(if bpath
(if (= 0 (getvar "SDI"))
(vla-activate (vla-open (vla-get-documents (vlax-get-acad-object)) bpath))
(vla-sendcommand
(vla-get-activedocument
(vlax-get-acad-object))
(strcat "(command \"_.open\")\n" bpath "\n") )
)
)
(setvar "cmdecho" cmdecho)
(setvar "regenmode" 1)
(princ)
); close defun
(princ)
;;; ----------- Insert & rededine Block --------------
(defun c:ReInsertBL ( / cmdecho regen n bpath)
(setq cmdecho (getvar "cmdecho"))
(setq regen (getvar "regenmode"))
(setvar "cmdecho" 0)
(setvar "regenmode" 0)
(setq ent (car (entsel "\nSelect Block Entity: ")))
                (if  (eq (cdr (assoc 0 (entget ent))) "INSERT")
                 (progn
                 (setq BLKN (vla-get-effectivename
                                       (vlax-ename->vla-object ent)))
                 )
                 )
(setq bpath (partsearch (strcat blkn ".dwg")))
(if bpath
(vl-cmdf "insert" (strcat blkn "=" bpath) )
(command) 
)
(setvar "cmdecho" cmdecho)
(setvar "regenmode" 1)
(princ)
); close defun
(princ)

By the first lisp command "openBL" is it possible that Autocad don't open the drawing if this one is already open!!!!

Please can somebody help me?

Try the following code:

(defun c:openbl ( / blk lst src usr )
   (cond
       (   (not (setq blk (selectblock "\nSelect block to open source drawing: "))))
       (   (not (setq src (findblock (strcat blk ".dwg"))))
           (princ (strcat "\n" blk ".dwg not found."))
       )
       (   (progn
               (vlax-for doc (vla-get-documents (vlax-get-acad-object))
                   (setq lst (cons (cons (strcase (vla-get-fullname doc)) doc) lst))
               )
               (assoc (strcase src) lst)
           )
           (vla-activate (cdr (assoc (strcase src) lst)))
       )
       (   (setq usr (LM:dwgopen-p src))
           (princ (strcat "\n" src " is currently in use by " usr))
       )
       (   (LM:open src))
   )
   (princ)
)

(defun c:reinsertbl ( / blk src val var )
   (cond
       (   (not (setq blk (selectblock "\nSelect block to redefine: "))))
       (   (not (setq src (findblock (strcat blk ".dwg"))))
           (princ (strcat "\n" blk ".dwg not found."))
       )
       (   (setq var '(cmdecho regenmode)
                 val  (mapcar 'getvar var)
           )
           (mapcar 'setvar var '(0 0))
           (command "_.-insert" (strcat blk "=" src) nil)
           (mapcar 'setvar var val)
       )
   )
   (princ)
)          

(defun selectblock ( msg / obj rtn )
   (while
       (progn (setvar 'errno 0) (setq obj (car (entsel msg)))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (/= "INSERT" (cdr (assoc 0 (entget obj))))
                   (princ "\nSelected object is not a block.")
               )
               (   (vlax-property-available-p (setq obj (vlax-ename->vla-object obj)) 'effectivename)
                   (null (setq rtn (vla-get-effectivename obj)))
               )
               (   (null (setq rtn (vla-get-name obj))))
           )
       )
   )
   rtn
)

(defun findblock ( dwg )
   (vl-some '(lambda ( p ) (findfile (strcat p dwg)))
      '(   ""
           "H:/bloc/profile/"
           "H:/bloc/gomme/"
       )
   )
)

;; Drawing Open-p  -  Lee Mac
;; Returns the owner of an open drawing, else nil if the drawing is unopen.
;; dwg - [str] Drawing filename

(defun LM:dwgopen-p ( dwg / dwl tmp usr )
   (if (and (setq dwl (findfile (strcat (substr dwg 1 (- (strlen dwg) 3)) "dwl")))
            (null (vl-file-delete dwl))
       )
       (if (setq tmp (open dwl "r"))
           (progn
               (setq usr (read-line tmp)
                     tmp (close tmp)
               )
               usr
           )
           "<Unknown>"
       )
   )
)

;; Open  -  Lee Mac
;; Uses the 'Open' method of the Shell Object to open the specified file or folder.
;; tar - [str/int] File, folder or ShellSpecialFolderConstants enum

(defun LM:open ( tar / shl rtn )
   (if (and (or (= 'int (type tar)) (setq tar (findfile tar)))
            (setq shl (vla-getInterfaceObject (vlax-get-acad-object) "shell.application"))
       )
       (progn
           (setq rtn (vl-catch-all-apply 'vlax-invoke (list shl 'open tar)))
           (vlax-release-object shl)
           (not (vl-catch-all-error-p rtn))
       )
   )
)

(vl-load-com) (princ)

Hi Lee,

I tested your lisp, it work with the directory link "H:/bloc/gomme/" and "H:/bloc/gomme/". I changed this direntory link to :

"P:/GBR_GreatBritain/02-DESIGN/02-05-BLOCKS/Gaskets/"

"P:/GBR_GreatBritain/02-DESIGN/02-05-BLOCKS/Castings/"

"P:/GBR_GreatBritain/02-DESIGN/02-05-BLOCKS/MouldingPieces/"

"P:/GBR_GreatBritain/02-DESIGN/02-05-BLOCKS/Accessories/"

now the lisp doesn't work ,block not found. Do you know why?

Hi Lee,

I think I found the problem : modification in green

I change also the block selection methode because I want to select the nested block : modification in red, is that OK???

(defun c:openbl ( / blk lst src usr )
   (cond
       (   (not (setq blk (selectblock "\nSelect block to open source drawing: "))))
       (   (not (setq src (findblock (strcat blk ".dwg"))))
           (princ (strcat "\n" blk ".dwg not found."))
       )
       (   (progn
               (vlax-for doc (vla-get-documents (vlax-get-acad-object))
                   (setq lst (cons (cons (strcase (vla-get-fullname doc)) doc) lst))
               )
               (assoc (strcase src) lst)
           )
           (vla-activate (cdr (assoc (strcase src) lst)))
       )
       (   (setq usr (LM:dwgopen-p src))
           (princ (strcat "\n" src " is currently in use by " usr))
       )
       (   (LM:open src))
   )
   (princ)
)
;;
(defun c:reinsertbl ( / blk src val var )
[b][i][color=red](while (/=(type(setq e (car(last(nentsel "\nSelect block to redefine: "))))) 'ENAME))
(setq obj (vlax-ename->vla-object e))
(if (= (vlax-get-property obj 'ObjectName) "AcDbBlockReference")
(setq blk (vlax-get-property obj
(if (vlax-property-available-p obj 'effectivename)'effectivename 'name))
);setq
);if[/color][/i][/b]
        (setq src (findblock (strcat blk ".dwg")))
           (princ (strcat "\n" blk ".dwg not found."))
       
       (   (setq var '(cmdecho regenmode)
                 val  (mapcar 'getvar var)
           )
           (mapcar 'setvar var '(0 0))
           (command "_.-insert" (strcat blk "=" src))
           (mapcar 'setvar var val)
       )
   
   (princ)
)      
;;    
(defun selectblock ( msg / obj rtn )
[b][i][color=red](while (/=(type(setq e (car(last(nentsel "\nSelect block to redefine: "))))) 'ENAME))
(setq obj (vlax-ename->vla-object e))
(if (= (vlax-get-property obj 'ObjectName) "AcDbBlockReference")
(setq rtn (vlax-get-property obj
(if (vlax-property-available-p obj 'effectivename)'effectivename 'name))
);setq
);if[/color][/i][/b]
)
;;
(defun findblock ( dwg )
   (vl-some '(lambda ( p ) (findfile (strcat p dwg)))
      '(   ""
[color=seagreen]"P:\\GBR_GreatBritain\\02-DESIGN\\02-05-BLOCKS\\Profiles\\" 
"P:\\GBR_GreatBritain\\02-DESIGN\\02-05-BLOCKS\\Gaskets\\"
"P:\\GBR_GreatBritain\\02-DESIGN\\02-05-BLOCKS\\Castings\\"
"P:\\GBR_GreatBritain\\02-DESIGN\\02-05-BLOCKS\\MouldingPieces\\"[/color] 
       )
   )
)
;; Drawing Open-p  -  Lee Mac
;; Returns the owner of an open drawing, else nil if the drawing is unopen.
;; dwg - [str] Drawing filename
(defun LM:dwgopen-p ( dwg / dwl tmp usr )
   (if (and (setq dwl (findfile (strcat (substr dwg 1 (- (strlen dwg) 3)) "dwl")))
            (null (vl-file-delete dwl))
       )
       (if (setq tmp (open dwl "r"))
           (progn
               (setq usr (read-line tmp)
                     tmp (close tmp)
               )
               usr
           )
           "<Unknown>"
       )
   )
)
;; Open  -  Lee Mac
;; Uses the 'Open' method of the Shell Object to open the specified file or folder.
;; tar - [str/int] File, folder or ShellSpecialFolderConstants enum
(defun LM:open ( tar / shl rtn )
   (if (and (or (= 'int (type tar)) (setq tar (findfile tar)))
            (setq shl (vla-getInterfaceObject (vlax-get-acad-object) "shell.application"))
       )
       (progn
           (setq rtn (vl-catch-all-apply 'vlax-invoke (list shl 'open tar)))
           (vlax-release-object shl)
           (not (vl-catch-all-error-p rtn))
       )
   )
)
(vl-load-com) (princ)

Try the following instead:

(defun c:openbl ( / blk lst src usr )
   (cond
       (   (not (setq blk (selectblock "\nSelect block to open source drawing: "))))
       (   (not (setq src (findblock (strcat blk ".dwg"))))
           (princ (strcat "\n" blk ".dwg not found."))
       )
       (   (progn
               (vlax-for doc (vla-get-documents (vlax-get-acad-object))
                   (setq lst (cons (cons (strcase (vla-get-fullname doc)) doc) lst))
               )
               (assoc (strcase src) lst)
           )
           (vla-activate (cdr (assoc (strcase src) lst)))
       )
       (   (setq usr (LM:dwgopen-p src))
           (princ (strcat "\n" src " is currently in use by " usr))
       )
       (   (LM:open src))
   )
   (princ)
)

(defun c:reinsertbl ( / blk src val var )
   (cond
       (   (not (setq blk (selectblock "\nSelect block to redefine: "))))
       (   (not (setq src (findblock (strcat blk ".dwg"))))
           (princ (strcat "\n" blk ".dwg not found."))
       )
       (   (setq var '(cmdecho regenmode)
                 val  (mapcar 'getvar var)
           )
           (mapcar 'setvar var '(0 0))
           (command "_.-insert" (strcat blk "=" src))
           (mapcar 'setvar var val)
       )
   )
   (princ)
)

(defun selectblock ( msg / enx obj rtn )
   (while
       (progn (setvar 'errno 0) (setq obj (nentsel msg))
           (cond
               (   (= 7 (getvar 'errno))
                   (princ "\nMissed, try again.")
               )
               (   (null obj) nil)
               (   (and (/= "ATTRIB" (cdr (assoc 0 (setq enx (entget (car obj))))))
                        (= 2 (length obj))
                   )
                   (princ "\nSelected object is not a block.")
               )
               (   (progn
                       (if (= "ATTRIB" (cdr (assoc 0 enx)))
                           (setq obj (cdr (assoc 330 enx)))
                           (setq obj (car (last obj)))
                       )
                       (vlax-property-available-p (setq obj (vlax-ename->vla-object obj)) 'effectivename)
                   )
                   (null (setq rtn (vla-get-effectivename obj)))
               )
               (   (null (setq rtn (vla-get-name obj))))
           )
       )
   )
   rtn
)

(defun findblock ( dwg )
   (vl-some '(lambda ( p ) (findfile (strcat p dwg)))
      '(   ""
           "P:\\GBR_GreatBritain\\02-DESIGN\\02-05-BLOCKS\\Profiles\\"
           "P:\\GBR_GreatBritain\\02-DESIGN\\02-05-BLOCKS\\Gaskets\\"
           "P:\\GBR_GreatBritain\\02-DESIGN\\02-05-BLOCKS\\Castings\\"
           "P:\\GBR_GreatBritain\\02-DESIGN\\02-05-BLOCKS\\MouldingPieces\\" 
       )
   )
)

;; Drawing Open-p  -  Lee Mac
;; Returns the owner of an open drawing, else nil if the drawing is unopen.
;; dwg - [str] Drawing filename

(defun LM:dwgopen-p ( dwg / dwl tmp usr )
   (if (and (setq dwl (findfile (strcat (substr dwg 1 (- (strlen dwg) 3)) "dwl")))
            (null (vl-file-delete dwl))
       )
       (if (setq tmp (open dwl "r"))
           (progn
               (setq usr (read-line tmp)
                     tmp (close tmp)
               )
               usr
           )
           "<Unknown>"
       )
   )
)

;; Open  -  Lee Mac
;; Uses the 'Open' method of the Shell Object to open the specified file or folder.
;; tar - [str/int] File, folder or ShellSpecialFolderConstants enum

(defun LM:open ( tar / shl rtn )
   (if (and (or (= 'int (type tar)) (setq tar (findfile tar)))
            (setq shl (vla-getInterfaceObject (vlax-get-acad-object) "shell.application"))
       )
       (progn
           (setq rtn (vl-catch-all-apply 'vlax-invoke (list shl 'open tar)))
           (vlax-release-object shl)
           (not (vl-catch-all-error-p rtn))
       )
   )
)
(vl-load-com) (princ)

I'm afraid I cannot advise regarding your paths - if the block cannot be found, the path must be incorrect.

Lee

Hi Lee

Is exactly what I needed, thank you a lot

Francine

Hi,

One last request, I have a lisp for redefine many blocks in a drawing. This lisp work well but when a have big drawing with lot of blocks the routines need sometimes 2minutes if not more. Is there a way to optimise this lisp. Perhaps redefine only blocks where the modified date is older as the drawing date!!!

I am also looking to do it with script and batch, I found this solution: http://www.widom-assoc.com/AU-CP12-3L.pdf but I need time to understand how it works.

(defun C:REDEF( / BLK BLT LAUF N WAH )
(setq G:LISTDIR (list
"P:\\02-DESIGN\\02-05-BLOCKS\\01-Profiles" 
"P:\\02-DESIGN\\02-05-BLOCKS\\02-Gaskets"
"P:\\02-DESIGN\\02-05-BLOCKS\\03-Castings"
"P:\\02-05-BLOCKS\\04-MouldingPieces" 
"P:\\02-DESIGN\\02-05-BLOCKS\\05-Accessories"
"P:\\02-DESIGN\\02-05-BLOCKS\\06-Brackets"
"P:\\02-DESIGN\\02-05-BLOCKS\\07-Elements" 
"P:\\02-DESIGN\\02-05-BLOCKS\\08-Structural"
"P:\\02-DESIGN\\02-05-BLOCKS\\09-Builderswork"
"P:\02-DESIGN\\02-05-BLOCKS\\10-FixingSpecialParts"
"P:\\02-DESIGN\\02-05-BLOCKS\\11-Sections"
"P:\\02-DESIGN\\02-05-BLOCKS\\12-SettingOut"
))
(if G:LISTDIR
 (progn
  (princ "\n\nDirectory list\n")
   (foreach N G:LISTDIR 
   (princ (strcat "\n" N))
  )
  (princ "\n***********************\n")
   (setvar "cmdecho" 0)
  (setvar "regenmode" 0) 
   (setq BLK nil
         LAUF 0
   )

   (while (setq BLT (tblnext "BLOCK" (= LAUF 0)))
          (setq LAUF 1)
          (setq BLK (cdr (assoc 2 BLT)) )
   (setq L:FLAGINSERT nil)
   (if (/= "*" (substr BLK 1 1))
    (progn
      (foreach N G:LISTDIR 
      (progn
        (setq L:FILE (strcat N "\\" BLK ".DWG"))
       (if (and (findfile L:FILE) (not L:FLAGINSERT))
        (progn
          (command "._INSERT" (strcat BLK "=" L:FILE))
         (command )
         (setq L:FLAGINSERT T)
         (princ (strcat "\n" L:FILE " reinserted"))
         )
         (progn
    ;     (princ (strcat L:FILE " not found\n"))
         )
       )
      )
      )
     (if (not L:FLAGINSERT )
      (princ (strcat "\nBlock " BLK " unchanged"))
     )
    )
   )
  )
   (setvar "cmdecho" 1)
  (setvar "regenmode" 1) 
  (princ "\n")
   (command "regen")
 )
)

 (princ)
)

Hi Lee

Is exactly what I needed, thank you a lot

Francine

You're welcome Francine.

One last request, I have a lisp for redefine many blocks in a drawing. This lisp work well but when a have big drawing with lot of blocks the routines need sometimes 2minutes if not more. Is there a way to optimise this lisp.

Is the following code any quicker?

(defun c:redef ( / blk def dir msp org src )
   (setq dir
      '(
           "P:\\02-DESIGN\\02-05-BLOCKS\\01-Profiles" 
           "P:\\02-DESIGN\\02-05-BLOCKS\\02-Gaskets"
           "P:\\02-DESIGN\\02-05-BLOCKS\\03-Castings"
           "P:\\02-05-BLOCKS\\04-MouldingPieces" 
           "P:\\02-DESIGN\\02-05-BLOCKS\\05-Accessories"
           "P:\\02-DESIGN\\02-05-BLOCKS\\06-Brackets"
           "P:\\02-DESIGN\\02-05-BLOCKS\\07-Elements" 
           "P:\\02-DESIGN\\02-05-BLOCKS\\08-Structural"
           "P:\\02-DESIGN\\02-05-BLOCKS\\09-Builderswork"
           "P:\\02-DESIGN\\02-05-BLOCKS\\10-FixingSpecialParts"
           "P:\\02-DESIGN\\02-05-BLOCKS\\11-Sections"
           "P:\\02-DESIGN\\02-05-BLOCKS\\12-SettingOut"
       )
   )
   (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
         org (vlax-3D-point 0 0)
   )
   (while (setq def (tblnext "block" (null def)))
       (if (and (wcmatch (setq blk (cdr (assoc 2 def))) "~`**")
                (setq src (vl-some'(lambda ( d ) (findfile (strcat d "\\" blk ".dwg"))) dir))
           )
           (vla-delete (vla-insertblock msp org src 1.0 1.0 1.0 0.0))
       )
   )
   (princ)
)
(vl-load-com) (princ)

Hello Lee,

I tried your lisp but I become only message like:

Duplicate definition of block EF4318 ignored.

Duplicate definition of block EP1780 ignored.

Duplicate definition of block EP1781 ignored.