(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)
)
(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
( (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.")
)