Topic: Import Blocks fails (tweak LM code)

[lamarn]

Hi

I am writing something with the use of Lee Mac block [insert block routine] to insert some stamp as blocks.
http://www.lee-mac.com/copyblockfromdrawing.html

I've written the subroutines. These work well. However, what i want is to place these subroutines in a main routine (different departments)
I can't get it to work passing to the next phase. Anybody have a clue where this might hang? To be honest , the code Lee writes is just above my league.
Attached is a screenshot of this problem with the succesful ending of dialog.

subroutine that works

Code: [Select]

(defun c:HI_PARAAF_tbb (/ *error* abc blk dbx dch dcl des doc dwg ins itm lst)
    (VL-LOAD-COM)
    (defun *error* (msg)
        (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
            (vlax-release-object dbx)
        )
        (if (= 'file (type des))
            (close des)
        )
        (if (and (= 'str (type dcl)) (findfile dcl))
            (vl-file-delete dcl)
        )
        (if (< 0 dch)
            (unload_dialog dch)
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    (setq dwg "C:\\_Data\\Heijmans\\AutoCAD_Tool\\user\\parafen-TBB.dwg")    ; THIS CAN BE DIFFERENT DWG'S DEPENDING ON A CHOICE
    (cond
        ((= (strcase dwg)
            (strcase
                (vla-get-fullname
                    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
                )
            )
         )
         (princ " ")
        )
        ((not (setq dbx (LM:GetDocumentObject dwg))) (princ " "))
        ((progn (vlax-for def (vla-get-blocks dbx)
                    (if (and (= :vlax-false (vla-get-isxref def))
                             (= :vlax-false (vla-get-islayout def))
                             (not (wcmatch (vla-get-name def) "`**,*|*"))
                        )
                        (setq lst (cons (vla-get-name def) lst))
                    )
                )
                (not (setq
                         lst (vl-sort
                                 (vl-remove-if '(lambda (x) (tblsearch "block" x))
                                               lst
                                 )
                                 '<
                             )
                     )
                )
         )
         (princ "\nNo distinct TBB blocks found in selected drawing.")
        )
        ((not
             (and
                 (setq dcl (vl-filename-mktemp nil nil ".dcl"))
                 (setq des (open dcl "w"))
                 (write-line
                     "importblock : dialog { label = \"Select TBB Block to Import\"; spacer;"
                     des
                 )
                 (write-line ": list_box { key = \"lst\"; } spacer; ok_cancel; }"
                             des
                 )
                 (not (setq des (close des)))
                 (< 0 (setq dch (load_dialog dcl)))
                 (new_dialog "importblock" dch)
             )
         )
         (princ "\nUnable to load \"Import Block\" dialog.")
        )
        (t
         (start_list "lst")
         (foreach itm lst (add_list itm))
         (end_list)
         (set_tile "lst" (setq itm "0"))
         (action_tile "lst" "(setq itm $value)")
         (if (= 1 (start_dialog))
             (if (and
                     (not (vl-catch-all-error-p
                              (vl-catch-all-apply
                                  'vlax-invoke
                                  (list dbx
                                        'copyobjects
                                        (list (LM:getitem
                                                  (vla-get-blocks dbx)
                                                  (setq blk (nth (atoi itm) lst))
                                              )
                                        )
                                        (setq abc (vla-get-blocks doc))
                                  )
                              )
                          )
                     )
                     (LM:getitem abc blk)
                 )  (if (setq ins (getpoint "\nSpecify point for TBB block: "))
                        (vla-insertblock
                            (vlax-get-property doc
                                               (if (= 1 (getvar 'cvport))
                                                   'paperspace
                                                   'modelspace
                                               )
                            )
                            (vlax-3D-point (trans ins 1 0))
                            blk
                            1.0
                            1.0
                            1.0
                            (angle '(0.0 0.0)
                                   (trans (getvar 'ucsxdir)
                                          0
                                          (trans '(0.0 0.0 1.0) 1 0 t)
                                          t
                                   )
                            )
                        )
                        (princ "\nUnable to import TBB block from selected drawing.")
                    )
             )
             (princ "\n*Cancel*")
         )
        )
    )
    (*error* nil)
    (princ)
)


Part that fails..
There is some conflict with this menu code that interrupts the code above.

Code: [Select]

(defun PARAAFSETMMMENU ()
    (setq DCL_ID
             (load_dialog
                 " .. support\\PARAAF_menu.dcl" ; A STANDARD BUTTON DIALOG
             )
    )
    (if (not (new_dialog "PARAAF_menu" DCL_ID))
        (progn (alert "File PARAAF_menu.dcl not found.") (exit)) ;progn
    ) ;_ end of if

    (action_tile "PARAAFSET_tbb" "(PARAAFSET_tbb) (done_dialog 1)")

    (action_tile "cancel" "(setq cancel t)(done_dialog)")
    (start_dialog)
)


(defun c:HI_PARAAF_MENU
       (/ *error* OLDERR abc blk dbx dch dcl des doc dwg ins itm lst)
    (graphscr)

    (setq  PARAAFSETTBBS NIL
          CANCEL nil
    ) ;_ end of setq

    (PARAAFSETMMMENU)

    (if PARAAFSETTBBS
        (cond ((= SEL 4) (PARAAFSET_TBB)))                                  ; THIS DOES NOT WORKING, FAILING TO END DIALOG SUCCESFUL)
    )

    (if CANCEL
        (princ "\nPROGRAM CANCELLED!")
    ) ;_ end of if
    (princ)
)

(defun PARAAFSET_TBB () (setq PARAAFSETTBBS t)  (c:HI_PARAAF_tbb))     ; THIS WORKS



[roy_043]

I have not looked at your video. To close a DCL dialog you would use the done_dialog function. It is unclear how the SEL variable receives its value. Perhaps some actions are defined in the DCL and you forgot to include a call to done_dialog there?

[lamarn]

The dialog indeed does not close properly
I can't figure out how this is done in order to start the next defun normal.

1. (action_tile "PARAAFSET_m" "(PARAAFSET_m) (done_dialog) ")   ; next function does not work
2. (action_tile "PARAAFSET_m" "(done_dialog) (PARAAFSET_m)")   ; does not close  the dialog
3. (action_tile "PARAAFSET_m" "(PARAAFSET_m) (exit)")               ; kills everything

(done_dialog [status])

?
status
Type: Integer

A positive integer that start_dialog will return instead of returning 1 for OK or 0 for Cancel. The meaning of any status value greater than 1 is determined by your application. [/i]


4. (action_tile "PARAAFSET_m"  "(c:HI_PARAAF_we) (done_dialog 2) ") ; same as 1.
5. (term_dialog)   ; same as 2.

[roy_043]

I have watched the movie now and IMO there are many inconsistencies. But I'll only address the problem that is preventing the code from working.

Code - Auto/Visual Lisp: [Select]

1. (defun PARAAFSETMMMENU ( / dcl ret)
2.   (if
3.     (or
4.       (and
5.         (<
6.           0
7.           (setq dcl
8.             (load_dialog "PARAAF_menu.dcl") ; A STANDARD BUTTON DIALOG
9.           )
10.         )
11.         (new_dialog "PARAAF_menu" dcl)
12.       )
13.       (progn
14.         (alert "Problem with the PARAAF_menu dialog")
15.         (exit)
16.       )
17.     )
18.     (progn
19.       ; (action_tile "cancel"      "(done_dialog 0)") ; This is the default action.
20.       ; (action_tile "accept"      "(done_dialog 1)") ; This is the default action.
21.       (action_tile "kunstwerken" "(done_dialog 2)")
22.       (action_tile "tbb"         "(done_dialog 3)")
23.       (action_tile "wegen"       "(done_dialog 4)")
24.       ; etc.
25.       (setq ret (start_dialog))
26.       (unload_dialog dcl)
27.       (cond
28.         ((= ret 2) "KUNSTWERKEN")
29.         ((= ret 3) "TBB")
30.         ((= ret 4) "WEGEN")
31.         ; etc.
32.       )
33.     )
34.   )
35. )
36.  
37. (defun c:HI_PARAAF_MENU ( / opt)
38.   (setq opt (PARAAFSETMMMENU))
39.   (cond
40.     ((= opt "KUNSTWERKEN")
41.       ; Do something
42.     )
43.     ((= opt "TBB")
44.       ; Do something
45.     )
46.     ((= opt "WEGEN")
47.       ; Do something
48.     )
49.     ; etc.
50.   )
51.   ; ...
52.   ; ...
53.   (princ)
54. )

[lamarn]

Thanks for your help.
Posted a 'full working version' in the zip for somebody else.

[lamarn]

Regarding the original code of mr. Lee. http://www.lee-mac.com/copyblockfromdrawing.html

How to make the 'NOT' part of the work as 'OR' ?
Would be really good to have some insert regardless if it was allready 'stolen' or not.


-------------------------=={ Import Block }==-------------------------
                                                                     
  This program allows a user to import a block from a selected       
  drawing into the active drawing, without opening the external file.
                                                                     
  Upon calling the program with 'IB' at the command line, the user   
  is prompted to select a drawing file from which to source the       
  block to be imported.                                               
                                                                     
  Following a valid response, a dialog is displayed prompting the     
  user to select a block from the list of blocks defined in the       
  selected drawing *NOT* (WISH FOR : OR) already present in the current drawing.   
                                                                     
  Following selection, the definition of the chosen block is imported
  into the drawing and the user is prompted to specify a block       
  insertion point at which a block reference of the imported block   
  is inserted.                                                       
                                                                     
  The program will perform successfully in all UCS/Views and is also 
  compatible with Dynamic Blocks.                                     
----------------------------------------------------------------------
  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com             
----------------------------------------------------------------------
  Version 1.2    -    16-06-2013                                     
----------------------------------------------------------------------

Code: [Select]


(   (progn
                (vlax-for def (vla-get-blocks dbx)
                    (if
                        (and
                            (= :vlax-false (vla-get-isxref   def))
                            (= :vlax-false (vla-get-islayout def))
                            (not (wcmatch (vla-get-name def) "`**,*|*"))
                        )
                        (setq lst (cons (vla-get-name def) lst))
                    )
                )
                (not (setq lst (vl-sort[b][i] (vl-remove-if '(lambda ( x ) (tblsearch "block" x)) lst)[/i][/b] '<)))
            )
            (princ "\nNo distinct blocks found in selected drawing.")
        )


This part? (vl-remove-if '(lambda ( x ) (tblsearch "block" x))