Author Topic: LISP working in AutoCAD but not in BricsCAD (Read 1374 times)

mailmaverick · « **on:** August 03, 2023, 01:23:59 PM »

Hi,
I have a LISP which is working in AutoCAD but not in Bricscad.
In AutoCAD, the program completes within few seconds whereas in BricsCAD, it goes into indefinite loop.

CAD file and LISP file is attached. Please help.

ribarm · « **Reply #1 on:** August 03, 2023, 02:02:20 PM »

It seems you missed in providing sub function MP:Echo...
Here is my output on textscreen...

Code: [Select]

: TEST

; ----- LISP : Call Stack -----
; [0]...C:TEST
; [1].....LISTEXPLODABLEBLOCKSWITHDIMLEADBLK <<--
;
; ----- Error around expression -----
; (MP:ECHO NIL)
;
; error : no function definition <MP:ECHO> ; expected FUNCTION at [eval]

danAllen · « **Reply #2 on:** August 03, 2023, 03:11:14 PM »

https://www.theswamp.org/index.php?topic=50848.msg559810#msg559810

ribarm · « **Reply #3 on:** August 03, 2023, 03:24:35 PM »

Seems to be working...
Small dialog box pops up and it is processing... There is also something happening on command line, but I haven't waited to see if it finishes as I don't quite know what's the purpose of routine on DWG provided... You are seems exploding nested blocks, but what does that matter in drawing that is IMHO completed drawing plan/project...

mailmaverick · « **Reply #4 on:** August 03, 2023, 07:51:49 PM »

Problem is not in MP:Echo. It is already loaded as per the link provided by DanAllen.
Also, the purpose is to explode all blocks before giving the drawing to anyone outside organisation. Exploding inside blocks doesn't disturb the dimensions, leaders etc which if exploded directly using 'EXPLODE' causes dimensions texts and arrows to go haywire. See attached drawing in which when you explode the block directly, the dimensions get disturbed.

It's Alive! · « **Reply #5 on:** August 04, 2023, 09:05:47 AM »

What’s to prevent people from wblocking the exploded block?

BIGAL · « **Reply #6 on:** August 05, 2023, 12:25:34 AM »

What version of Bricscad some VL functions were not in earlier versions.

Other suggestion is put (princ "\n1") in code then further down (princ "\n2") etc look for last number gives a clue where to start looking.

mailmaverick · « **Reply #7 on:** August 05, 2023, 05:50:49 AM »

I am using BricsCAD latest version (v23).
Also as you said that some VL functions were not in earlier versions. If that was the case, the program would give undefined function error but it doesn't. It just goes into infinite loop. So all the functions used in the LISP are read by BricsCAD.

ribarm · « **Reply #8 on:** August 05, 2023, 01:00:17 PM »

Quote from: mailmaverick on August 05, 2023, 05:50:49 AM

I am using BricsCAD latest version (v23).
Also as you said that some VL functions were not in earlier versions. If that was the case, the program would give undefined function error but it doesn't. It just goes into infinite loop. So all the functions used in the LISP are read by BricsCAD.

I took some time to remedy your code... Looks better and on my end it functions, but on some other DWG, as your is finished story... When I run on your DWG it iterates through blocks - pass 1, pass 2, pass ... And there is nothing to explode... When I on the other hand create block within block on blank DWG it does what should... HTH., M.R.

Code - Auto/Visual Lisp: [Select]

(defun C:Test (/ *error* MP:Echo exnest exnest:explode LM:name->effectivename listExplodableBlockswithDimLeadBlk _kpblc-conv-vla-to-list fun_explode explinside adoc osm ort qaf ctb pass expblklist totblks cnt origblk )
 
  (defun *error* ( m )
    (if osm
      (setvar 'osmode osm)
    )
    (if ort
      (setvar 'orthomode ort)
    )
    (if qaf
      (setvar 'qaflags qaf)
    )
    (if ctb
      (setvar 'ctab ctb)
    )
    (if adoc
      (vla-endundomark adoc)
    )
    (if m
      (prompt m)
    )
    (princ)
  )
 
  (defun MP:Echo ( x / cmdecho millisecs ceiling )
    (cond
      ( (null (setq ceiling 2000 millisecs (getvar 'millisecs)))
      )
      ( (/= 'int (type *MP:Echo:MilliSecs*))
        (setq *MP:Echo:MilliSecs* millisecs)
      )
      ( (< ceiling (- millisecs *MP:Echo:MilliSecs*))
        (setq cmdecho (getvar 'cmdecho))
        (setvar 'cmdecho 0)
        (vl-cmdf ".delay" 0)
        (setvar 'cmdecho cmdecho)
        (setq *MP:Echo:MilliSecs* millisecs)
      )
    )
    (if (eq 'str (type x))
      (setvar 'modemacro (vl-string-trim "\n\r\t" x))
    )
    (princ x)
    (princ)
  )
  (defun exnest ( ent / obj )
    ;; explode nested blocks only (not the parent block)
    (if ent
      (progn
        (vlax-for obj (vla-item (vla-get-blocks adoc) (LM:name->effectivename (cdr (assoc 2 (entget ent)))))
          (exnest:explode obj)
        )
        (vla-regen adoc acallviewports)
      )
    )
    (princ)
  )
  (defun exnest:explode ( obj / lst )
    (if
      (and
        (= "AcDbBlockReference" (vla-get-objectname obj))
        (vlax-write-enabled-p obj)
        (not (vl-catch-all-error-p (setq lst (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))))
      )
      (progn
        (foreach obj lst
          (exnest:explode obj)
        )
        (vla-delete obj)
      )
    )
  )
  (defun LM:name->effectivename ( blk / rep )
    ;; Block Name -> Effective Block Name
    ;; blk - [str] Block name
    (if
      (and
        (wcmatch blk "`**")
        (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag")))))
        (setq rep (handent (cdr (assoc 1005 rep))))
      )
      (cdr (assoc 2 (entget rep)))
      blk
    )
  )
  (defun listExplodableBlockswithDimLeadBlk ( / blk blks count ent expblklst fndcnt idx n n1 o objn ss step )
    ;; Lists explodable blocks with Dimensions, Leaders, Blocks inside
    (setq expblklst (list))
    (setq fndcnt 0)
    (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
    (if (setq ss (ssget "_X" (list (cons 410 (getvar 'ctab)) (cons 0 "*BLOCK*,*INSERT*"))))
      (progn (setq step (max 1 (fix (/ (sslength ss) 100))))
        (repeat (setq n1 (sslength ss))
          (if (eq (rem n1 step) 0)
            (progn
              (acet-ui-status
                (strcat (itoa n1)
                        " blocks remaining, out of total of "
                        (itoa (sslength ss))
                        " blocks.\nFound "
                        (itoa fndcnt)
                        " blocks to be Exploded."
                )
              )
              (MP:Echo nil)
              (while (< 0 (getvar 'cmdactive))
                (command "")
              )
              (command "_.delay" 0)
            )
          )
          (setq ent (ssname ss (setq n1 (1- n1))))
          (if
            (eq
              (vla-get-explodable (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget ent))))) :vlax-true
            )
            (progn                        ;insert object
              (setq o (vlax-ename->vla-object ent)
                    n (vla-get-effectivename o) ;name
              )
              (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list blks n))))
                (progn
                  (setq blk (vla-item blks n)
                        idx -1
                        count (vla-get-count blk)
                  )
                  (while (< (setq idx (1+ idx)) count)
                    (setq n (vla-item blk idx))
                    (setq objn (strcase (vla-get-objectname n)))
                    (if
                      (or
                        (vl-string-search "DIMENSION" objn)
                        (vl-string-search "LEADER" objn)
                        (vl-string-search "INSERT" objn)
                        (vl-string-search "BLOCK" objn)
                      )
                      (progn ;;
                        (setq fndcnt (1+ fndcnt))
                        (setq expblklst (append expblklst (list ent)))
                        (setq idx count)
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
    expblklst
  )
  (defun _kpblc-conv-vla-to-list ( value / res )
    (cond
      ( (listp value)
        (mapcar (function _kpblc-conv-vla-to-list) value)
      )
      ( (= (type value) 'variant)
        (_kpblc-conv-vla-to-list (vlax-variant-value value))
      )
      ( (= (type value) 'safearray)
        (if (>= (vlax-safearray-get-u-bound value 1) 0)
          (_kpblc-conv-vla-to-list (vlax-safearray->list value))
        ) ;_ end of if
      )
      ( (and (= (type value) 'vla-object) (vlax-property-available-p value 'count))
        (vlax-for sub value (setq res (cons sub res)))
      )
      ( t value )
    ) ;_ end of cond
  ) ;_ end of defun
  (defun fun_explode ( ent / res def )
    (cond
      ( (vlax-method-applicable-p ent 'explode)
        (foreach sub (vla-explode ent) (fun_explode sub))
        (vla-erase ent)
      )
      ;;((wcmatch (strcase (vla-get-objectname ent)) "ACDB*DIM*")
      ( T
        (setq def (vla-item (vla-get-blocks adoc) (cdr (assoc 2 (entget (vlax-vla-object->ename ent)))))
              def (_kpblc-conv-vla-to-list def)
        ) ;_ end of setq
        (vla-copyobjects
          adoc
          (vlax-make-variant
            (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length def)))) def)
          ) ;_ end of vlax-make-variant
          (vla-objectidtoobject adoc (vla-get-ownerid ent))
        ) ;_ end of vla-CopyObjects
        (vla-erase ent)
      )
    ) ;_ end of cond
  ) ;_ end of defun
  (defun explinside ( ent / sub )
    ;; Source : http://www.theswamp.org/index.php?topic=56094.0
    (cond ;_ end of type
      ( (/= (type ent) 'ename) ;_ end of /=
        (princ "\nNothing selected")
      )
      ( (vl-catch-all-error-p
          (setq ent
            (vl-catch-all-apply
              (function
                (lambda () (vla-item (vla-get-blocks adoc) (vla-get-effectivename (vlax-ename->vla-object ent))))
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of setq
        ) ;_ end of vl-catch-all-error-p
        (princ "\nCan't recognize block definition")
      )
      ( T
        ;;(vla-startundomark adoc)
        (vlax-for sub ent (vl-catch-all-apply (function (lambda () (fun_explode sub)))))
        ;;(vla-endundomark adoc)
      )
    ) ;_ end of cond
    (princ)
  ) ;_ end of defun
  ;;
  ;;
  ;;
  ;;
  ;;
  ;;----------------------------------------------------------------------;;
  ;;                         Actual Program Started                       ;;
  ;;----------------------------------------------------------------------;;
  ;;
  ;;
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (= 8 (logand 8 (getvar 'undoctl)))
    (vla-endundomark adoc)
  )
  (vla-startundomark adoc)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (setq ort (getvar 'orthomode))
  (setvar 'orthomode 0)
  (acet-ui-status "ExplodeInsideBlocks")
  (command)
  (setq qaf (getvar 'qaflags))
  (setvar "QAFLAGS" 0)
  (setq ctb (getvar 'ctab))
  (setvar 'ctab "Model")
  (command)
  (setq pass 0)
  (while (setq expblklist (listExplodableBlockswithDimLeadBlk))
    (setq totblks (length expblklist))
    (setq cnt 1)
    (foreach blk expblklist
      (acet-ui-status
        (strcat "Pass " (itoa pass) " : Exploding Inside block " (itoa cnt) " of total " (itoa totblks))
      )
      (MP:Echo nil)
      (while (< 0 (getvar 'cmdactive))
        (command "")
      )
      (command "_.delay" 0)
      (command)
      (setq origblk blk)
      (exnest origblk)
      (explinside origblk)
      (exnest origblk)
      (explinside origblk)
      (command)
      (setvar "QAFLAGS" 1)
      (vl-cmdf "_.explode" origblk)
      (while (< 0 (getvar 'cmdactive))
        (command "")
      )
      (setvar "QAFLAGS" 0)
      (setq cnt (1+ cnt))
    )
    (setq pass (1+ pass))
  )
  (command)
  (acet-ui-status)
  (*error* nil)
)
 

Regards...

News:

Author Topic: LISP working in AutoCAD but not in BricsCAD (Read 1374 times)

mailmaverick

LISP working in AutoCAD but not in BricsCAD

ribarm

Re: LISP working in AutoCAD but not in BricsCAD

danAllen

Re: LISP working in AutoCAD but not in BricsCAD

ribarm

Re: LISP working in AutoCAD but not in BricsCAD

mailmaverick

Re: LISP working in AutoCAD but not in BricsCAD

It's Alive!

Re: LISP working in AutoCAD but not in BricsCAD

BIGAL

Re: LISP working in AutoCAD but not in BricsCAD

mailmaverick

Re: LISP working in AutoCAD but not in BricsCAD

ribarm

Re: LISP working in AutoCAD but not in BricsCAD