Reactor to reinsert block after PURGE

C.Utzinger · ‎01-25-2018

HI

Why does AutoCAD refuse the command "_.insert"???

(defun c:<Test1 ( / )

 (vl-load-com)

(defun VTF2 (CALL CALLBACK)
   (if (= (strcase (car CALLBACK)) "PURGE")      
       (if (not (tblsearch "block" "el_1")) 
           (progn (command "_.insert" "el_1")(command)))
   )
)

(setq VTFRXN2 (vlr-editor-reactor nil '((:VLR-commandEnded . VTF2))))

)

Regards

_gile · ‎01-25-2018

Hi,

You cannot use the command function within a reactor callback function.

You can set "unpurgeable" a block definition (or any other object) using a hard pointer.

Some routines from my tool box:

;; gc:GetExtDict (gile)
;; Gets the object extension dictionary (or nil)
;;
;; Argument : obj (ENAME)

(defun gc:GetExtDict (obj)
  (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget obj)))
)

;; gc:GetOrCreateExtDict (gile)
;; Gets the object extension dictionary
;; The dictionary is created if not already exists
;;
;; Argument : obj (ENAME)

(defun gc:GetOrCreateExtDict (ent / dict)
  (cond
    ((cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget ent))))
    ((setq dict	(entmakex
		  '((0 . "DICTIONARY") (100 . "AcDbDictionary"))
		)
     )
     (entmod
       (vl-list*
         (assoc -1 elst)
         (assoc 0 elst)
         (assoc 5 elst)
         (cons 102 "{ACAD_XDICTIONARY")
         (cons 360 dict)
         (cons 102 "}")
         (vl-remove-if (function (lambda (x) (member (car x) '(-1 0 5)))) elst)
       )
     )
     dict
    )
  )
)

;; gc:SetXrecData  (gile)
;; Returns the ENAME of the xrecord which data are set to
;;
;; Arguments
;; dict : ENAME of the parent dictionary
;; key  : name of the xrecord
;; data : dotted pair list containg data

(defun gc:SetXrecData (dict key data / xrec)
  (if (snvalid key)
    (progn
      (and (setq xrec (dictsearch dict key))
           (entdel (cdr (assoc -1 xrec)))
      )
      (dictadd
        dict
        key
        (entmakex
          (append
            (list '(0 . "XRECORD")
                  '(100 . "AcDbXrecord")
            )
            data
          )
        )
      )
    )
  )
)

;; gc:GetXrecData  (gile)
;; Gets the data of the xreord (dooted pair list)
;;
;; Arguments
;; dict : ENAME of the parent dictionary
;; key  : name of the xrecord

(defun gc:GetXrecData (dict key / xrec)
  (if (and
        (setq xrec (dictsearch dict key))
        (= (cdr (assoc 0 xrec)) "XRECORD")
      )
    (cdr (member (assoc 280 xrec) xrec))
  )
)

;; gc:SetUnPurgeable  (gile)
;; Sets unpurgeable the table record (AcDbSymbolTableRecord)
;; Returns T if succeeded; nil otherwise
;;
;; Arguments
;; table : the table name
;; name  : the record name

(defun gc:SetUnPurgeable (table name / symbol xdict)
  (and
    (setq symbol (tblobjname table name))
    (setq xdict (gc:GetOrCreateExtDict
                  (cdr (assoc -1 (entget (cdr (assoc 330 (entget symbol))))))
                )
    )
    (gc:SetXrecData
      xdict
      "UnPurge"
      (cons (cons 340 symbol) (gc:GetXrecData xdict "UnPurge"))
    )
  )
)

;; gc:ResetPurgeable  (gile)
;; Reset purgeable the table record (AcDbSymbolTableRecord)
;;
;; Arguments
;; table : the table name
;; name  : the record name

(defun gc:ResetPurgeable (table name / symbol xdict)
  (and
    (setq symbol (tblobjname table name))
    (setq xdict (gc:GetOrCreateExtDict
                  (cdr (assoc 330 (entget symbol)))
                )
    )
    (setq data (gc:GetXrecData xdict "UnPurge"))
    (member (cons 340 symbol) data)
    (or
      (and (= 1 (length data)) (dictremove xdict "UnPurge"))
      (gc:SetXrecData
        xdict
        "UnPurge"
        (vl-remove (cons 340 symbol) data)
      )
    )
  )
)

;; gc:ResetAllPurgeable  (gile)
;; Reset purgeable all records previously set as unpurgeable

(defun gc:ResetAllPurgeable (/ name symbol xdict)
  (foreach table '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
    (and
      (setq name (cdr (assoc 2 (tblnext table T))))
      (setq symbol (tblobjname table name))
      (setq xdict (gc:GetExtDict (cdr (assoc 330 (entget symbol)))))
      (gc:GetXrecData xdict "UnPurge")
      (dictremove xdict "UnPurge")
    )
  )
)

Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

C.Utzinger · ‎01-25-2018

OK!

I got T when I use it like this:

But I still can purge the block. Is that correct?

(gc:SetUnPurgeable "block" "el_1")

Thank you!

_gile · ‎01-25-2018

Oopss!...

My mistake, I pasted the wrong code, try this one.

;; gc:GetExtDict (gile)
;; Gets the object extension dictionary (or nil)
;;
;; Argument : obj (ENAME)

(defun gc:GetExtDict (obj)
  (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget obj)))
)

;; gc:GetOrCreateExtDict (gile)
;; Gets the object extension dictionary
;; The dictionary is created if not already exists
;;
;; Argument : obj (ENAME)

(defun gc:GetOrCreateExtDict (ent / dict)
  (cond
    ((cdadr (member '(102 . "{ACAD_XDICTIONARY") (setq elst (entget ent)))))
    ((setq dict	(entmakex
		  '((0 . "DICTIONARY") (100 . "AcDbDictionary"))
		)
     )
     (entmod
       (vl-list*
         (assoc -1 elst)
         (assoc 0 elst)
         (assoc 5 elst)
         (cons 102 "{ACAD_XDICTIONARY")
         (cons 360 dict)
         (cons 102 "}")
         (vl-remove-if (function (lambda (x) (member (car x) '(-1 0 5)))) elst)
       )
     )
     dict
    )
  )
)

;; gc:SetXrecData  (gile)
;; Returns the ENAME of the xrecord which data are set to
;;
;; Arguments
;; dict : ENAME of the parent dictionary
;; key  : name of the xrecord
;; data : dotted pair list containg data

(defun gc:SetXrecData (dict key data / xrec)
  (if (snvalid key)
    (progn
      (and (setq xrec (dictsearch dict key))
           (entdel (cdr (assoc -1 xrec)))
      )
      (dictadd
        dict
        key
        (entmakex
          (append
            (list '(0 . "XRECORD")
                  '(100 . "AcDbXrecord")
            )
            data
          )
        )
      )
    )
  )
)

;; gc:GetXrecData  (gile)
;; Gets the data of the xreord (dooted pair list)
;;
;; Arguments
;; dict : ENAME of the parent dictionary
;; key  : name of the xrecord

(defun gc:GetXrecData (dict key / xrec)
  (if (and
        (setq xrec (dictsearch dict key))
        (= (cdr (assoc 0 xrec)) "XRECORD")
      )
    (cdr (member (assoc 280 xrec) xrec))
  )
)

;; gc:SetUnPurgeable  (gile)
;; Sets unpurgeable the table record (AcDbSymbolTableRecord)
;; Returns T if succeeded; nil otherwise
;;
;; Arguments
;; table : the table name
;; name  : the record name

(defun gc:SetUnPurgeable (table name / symbol record xdict)
  (and
    (setq symbol (tblobjname table name))
    (setq record (cdr (assoc 330 (entget symbol))))
    (setq xdict (gc:GetOrCreateExtDict
                  (cdr (assoc -1 (entget (cdr (assoc 330 (entget record))))))
                )
    )
    (gc:SetXrecData
      xdict
      "UnPurge"
      (cons (cons 340 record) (gc:GetXrecData xdict "UnPurge"))
    )
  )
)

;; gc:ResetPurgeable  (gile)
;; Reset purgeable the table record (AcDbSymbolTableRecord)
;;
;; Arguments
;; table : the table name
;; name  : the record name

(defun gc:ResetPurgeable (table name / symbol record xdict)
  (and
    (setq symbol (tblobjname table name))
    (setq record (cdr (assoc 330 (entget symbol))))
    (setq xdict (gc:GetOrCreateExtDict (cdr (assoc 330 (entget record)))))
    (setq data (gc:GetXrecData xdict "UnPurge"))
    (member (cons 340 record) data)
    (or
      (and (= 1 (length data)) (dictremove xdict "UnPurge"))
      (gc:SetXrecData
        xdict
        "UnPurge"
        (vl-remove (cons 340 symbol) data)
      )
    )
  )
)

;; gc:ResetAllPurgeable  (gile)
;; Reset purgeable all records previously set as unpurgeable

(defun gc:ResetAllPurgeable (/ name record xdict)
  (foreach table '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
    (and
      (setq name (cdr (assoc 2 (tblnext table T))))
      (setq record (cdr (assoc 330 (entget (tblobjname table name)))))
      (setq xdict (gc:GetExtDict (cdr (assoc 330 (entget record)))))
      (gc:GetXrecData xdict "UnPurge")
      (dictremove xdict "UnPurge")
    )
  )
)

Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

C.Utzinger · ‎01-25-2018

Thank you very much!

It works prefect!

Best regards

C.Utzinger · ‎01-29-2018

HI

I have a Little problem with the gc:ResetPurgeable function. It does not work 😉

The gc:ResetAllPurgeable works perfect.

Can give me another Hand please? Thank you!

Kind regards

_gile · ‎01-29-2018

This one should work.

;; gc:GetExtDict (gile)
;; Gets the object extension dictionary (or nil)
;;
;; Argument : obj (ENAME)

(defun gc:GetExtDict (obj)
  (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget obj)))
)

;; gc:GetOrCreateExtDict (gile)
;; Gets the object extension dictionary
;; The dictionary is created if not already exists
;;
;; Argument : obj (ENAME)

(defun gc:GetOrCreateExtDict (ent / dict)
  (cond
    ((cdadr (member '(102 . "{ACAD_XDICTIONARY") (setq elst (entget ent)))))
    ((setq dict	(entmakex
		  '((0 . "DICTIONARY") (100 . "AcDbDictionary"))
		)
     )
     (entmod
       (vl-list*
         (assoc -1 elst)
         (assoc 0 elst)
         (assoc 5 elst)
         (cons 102 "{ACAD_XDICTIONARY")
         (cons 360 dict)
         (cons 102 "}")
         (vl-remove-if (function (lambda (x) (member (car x) '(-1 0 5)))) elst)
       )
     )
     dict
    )
  )
)

;; gc:SetXrecData  (gile)
;; Returns the ENAME of the xrecord which data are set to
;;
;; Arguments
;; dict : ENAME of the parent dictionary
;; key  : name of the xrecord
;; data : dotted pair list containg data

(defun gc:SetXrecData (dict key data / xrec)
  (if (snvalid key)
    (progn
      (and (setq xrec (dictsearch dict key))
           (entdel (cdr (assoc -1 xrec)))
      )
      (dictadd
        dict
        key
        (entmakex
          (append
            (list '(0 . "XRECORD")
                  '(100 . "AcDbXrecord")
            )
            data
          )
        )
      )
    )
  )
)

;; gc:GetXrecData  (gile)
;; Gets the data of the xreord (dooted pair list)
;;
;; Arguments
;; dict : ENAME of the parent dictionary
;; key  : name of the xrecord

(defun gc:GetXrecData (dict key / xrec)
  (if (and
        (setq xrec (dictsearch dict key))
        (= (cdr (assoc 0 xrec)) "XRECORD")
      )
    (cdr (member (assoc 280 xrec) xrec))
  )
)

;; gc:SetUnPurgeable  (gile)
;; Sets unpurgeable the table record (AcDbSymbolTableRecord)
;; Returns T if succeeded; nil otherwise
;;
;; Arguments
;; table : the table name
;; name  : the record name

(defun gc:SetUnPurgeable (table name / symbol record xdict)
  (and
    (setq symbol (tblobjname table name))
    (setq record (cdr (assoc 330 (entget symbol))))
    (setq xdict (gc:GetOrCreateExtDict
                  (cdr (assoc -1 (entget (cdr (assoc 330 (entget record))))))
                )
    )
    (gc:SetXrecData
      xdict
      "UnPurge"
      (cons (cons 340 record) (gc:GetXrecData xdict "UnPurge"))
    )
  )
)

;; gc:ResetPurgeable  (gile)
;; Reset purgeable the table record (AcDbSymbolTableRecord)
;;
;; Arguments
;; table : the table name
;; name  : the record name

(defun gc:ResetPurgeable (table name / symbol record xdict)
  (and
    (setq symbol (tblobjname table name))
    (setq record (cdr (assoc 330 (entget symbol))))
    (setq xdict (gc:GetOrCreateExtDict (cdr (assoc 330 (entget record)))))
    (setq data (gc:GetXrecData xdict "UnPurge"))
    (member (cons 340 record) data)
    (or
      (and (= 1 (length data)) (dictremove xdict "UnPurge"))
      (gc:SetXrecData
        xdict
        "UnPurge"
        (vl-remove (cons 340 record) data)
      )
    )
  )
)

;; gc:ResetAllPurgeable  (gile)
;; Reset purgeable all records previously set as unpurgeable

(defun gc:ResetAllPurgeable (/ name record xdict)
  (foreach table '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
    (and
      (setq name (cdr (assoc 2 (tblnext table T))))
      (setq record (cdr (assoc 330 (entget (tblobjname table name)))))
      (setq xdict (gc:GetExtDict (cdr (assoc 330 (entget record)))))
      (gc:GetXrecData xdict "UnPurge")
      (dictremove xdict "UnPurge")
    )
  )
)

Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Community

Reactor to reinsert block after PURGE

Reactor to reinsert block after PURGE

Reactor to reinsert block after PURGE