Delete XData with a specified application name from a selected entity

[peter]

One thing that has always been problematic with xdata is you can't delete it from an entity (with ActiveX).

Apparently there is a way with entmod (see below)

We have always been limited to vla-setxdata and vla-getxdata.

Although it is possible to delete xdata using .net

Imports Autodesk.AutoCAD
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
''' <summary>
''' Functions to delete (dispose) XData from Entities
''' </summary>

Public Class XdataDisposeClass1
    ''' <summary>
    ''' LISP Function to delete (dispose) of specific Xdata application information from an entity.
    ''' </summary>
    ''' <param name="rbfArguments"></param>
    ''' <returns> T for success - nil for failure </returns>
    ''' <remarks> LISP Syntax: (XdataDispose (entlast) "TEST") </remarks>
    <LispFunction("XdataDispose")> _
    Public Function XdataDelete(ByVal rbfArguments As ResultBuffer)
        Try
            Dim arrArguments As TypedValue() = rbfArguments.AsArray
            If arrArguments.Length = 2 And _
                arrArguments(0).TypeCode = LispDataType.ObjectId And _
                arrArguments(1).TypeCode = LispDataType.Text Then
                If Not XdataDispose(arrArguments(0).Value, _
                                    arrArguments(1).Value.ToString.ToUpper) = Nothing Then
                    Return New TypedValue(LispDataType.T_atom, -1)
                End If
            End If
        Catch exception As Exception
        End Try
        Return Nothing

    End Function

    ''' <summary>
    ''' Comand line function to delete (dispose) of specific xdata application information.
    ''' </summary>
    ''' <remarks></remarks>
    <CommandMethod("XdataDispose")> _
    Public Sub XdataDispose()
        Dim document As Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim editor As Editor = document.Editor
        Dim promptresult As PromptResult = editor.GetString("Enter XData Application Name")
        Dim strApplication As String = promptresult.StringResult.ToUpper
        Dim transaction As Transaction = document.TransactionManager.StartTransaction
        Try
            Dim promptEntityResult As PromptEntityResult = editor.GetEntity("Select Entity")
            If promptEntityResult IsNot Nothing Then
                Dim entity As Entity = transaction.GetObject(promptEntityResult.ObjectId, OpenMode.ForRead)
                XdataDispose(promptEntityResult.ObjectId, strApplication.ToUpper)
                transaction.Commit()
            End If
        Catch exception As Exception
            transaction.Abort()
        End Try
        transaction.Dispose()
    End Sub

    ''' <summary>
    ''' General Function to Delete (Dispose) of a specific xdata application from an object
    ''' </summary>
    ''' <param name="oidItem"></param>
    ''' <param name="strApplication"></param>
    ''' <returns>True for Success - Nothing for Failure</returns>
    Public Function XdataDispose(ByVal oidItem As ObjectId, ByVal strApplication As String)
        Dim document As Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim transaction As Transaction = document.TransactionManager.StartTransaction
        Try
            Dim entity As Entity = transaction.GetObject(oidItem, OpenMode.ForRead)
            Dim rbfXdata As ResultBuffer = entity.GetXDataForApplication(strApplication)
            If rbfXdata IsNot Nothing Then
                entity.UpgradeOpen()
                entity.XData = New ResultBuffer(New TypedValue(1001, strApplication))
                rbfXdata.Dispose()
                transaction.Commit()
                Return True
            End If
        Catch exception As Exception
            transaction.Abort()
        End Try
        Return Nothing
    End Function
End Class

[BlackBox]

One thing that has always been problematic with xdata is you can't delete it from an entity (with LISP).

We have always been limited to vla-setxdata and vla-getxdata.

Have you been unsuccessful removing XData with ENTMOD?

Here's a LISP sub-function that removes XData, dated early 1999; the first result in a Google search for "autocad lisp delete xdata" FWIW.

Cheers

[peter]

I am sure that many things are possible using old fashioned autolisp... that is not my point...

The focus of this forum is to extend the power of LISP creating useful functions in .NET...

Below are some useful tools for XDATA including a command line version that allows you to create a selection set and delete
specific applications using wildcards.

P=

;___________________________________________________________________________________________________________
;
; Command line Funtion to delete xdata from a selection set with a wildcard filter for applications names
;___________________________________________________________________________________________________________

(defun C:XdataDelete (/ intCount ssSelections strWCFilter)
 (if (and 
      (setq strWCFilter (strcase (getstring "\nEnter Xdata Application WC Filter Name: ")))
      (princ "\nSelect objects to remove xdata from: ")
      (setq ssSelections (ssget))
     )
  (repeat (setq intCount (sslength ssSelections))
   (setq intCount (1- intCount))
   (xdatadelete (vlax-ename->vla-object (ssname ssSelections intCount)) strWCFilter)
  )   
 )
 (princ)
)

;___________________________________________________________________________________________________________
;
; Funtion to delete xdata from an object with a wildcard filter for applications names
; LISP Syntax: (xdatadelete obj "TEST#")
;___________________________________________________________________________________________________________

(defun XdataDelete (objSelection
                     strWCFilter
                     /
                     lstApplictions
                     lstFiltered
                     strApplication
                    )
 (if (not 'xdatadispose)
  (errortrap (quote (command "netload" (findfile "xdatadispose.dll"))))
 )
 (if (setq lstApplications (mapcar 'car (xdataget objSelection)))
  (foreach strApplication lstApplications
   (if (wcmatch strApplication strWCFilter)
    (setq lstFiltered (cons strApplication lstFiltered))
   )
  )
 )
 (if lstFiltered
  (apply 'and 
         (mapcar '(lambda (X)(xdatadispose (vlax-vla-object->ename objSelection) X))
                  lstFiltered
         )
  )
 )
)

;___________________________________________________________________________________________________________
;
; Funtion to get xdata from an object and return a list of sublists
; LISP Syntax: (xdataget obj) Returns '(("TEST1" 1 0)("TEST2" 2)("TESTA" "A"))
;___________________________________________________________________________________________________________


(defun XDataGet (objSelection 
                 / 
                 intCount 
                 intDXFCode
                 lstAll 
                 lstDXFCodes 
                 lstDataValues
                 lstSub 
                 safDXFCodes 
                 safDataValues
                )
 (if (and objSelection
         (errortrap (quote (vla-getxdata objSelection "" 'safDXFCodes 'safDataValues) )) 
          safDXFCodes
          safDataValues
         (setq lstDXFCodes   (vlax-safearray->list safDXFCodes)) 
         (setq lstDataValues (mapcar 'variant-value (vlax-safearray->list safDataValues)))  
         (setq intCount 0)
     )
  (foreach intDXFCode lstDXFCodes
   (if (= intDXFCode 1001)
    (if lstSub
     (setq lstAll (cons (reverse lstSub) lstAll)
           lstSub (list (nth intCount lstDataValues))
     )
     (setq lstSub (list (nth intCount lstDataValues)))  
    )
    (setq lstSub (cons (nth intCount lstDataValues) lstSub))   
   )
   (setq intCount (1+ intCount))
  )
 )
 (if lstSub (reverse (cons (reverse lstSub) lstAll)))
)

;___________________________________________________________________________________________________________
; 
; The XDataPut function will add a list of sublists to an object as xdata.
; The first item in each sublist is a unique string application name
; LISP Syntax: (xdataput obj '(("TEST1" 1 0)("TEST2" 2)("TESTA" "A")))
;___________________________________________________________________________________________________________

(defun XDataPut (objSelection 
                 lstOfSubLists 
                 / 
                 DataItem 
                 lstData
                 intDataType 
                 lstDXFCodes 
                 lstDataValues 
                 lstSublist
                 safDXFCodes 
                 safDataValues
                )                

 (if objSelection
  (progn
   (foreach lstData lstOfSublists
    (setq lstDXFCodes   (cons 1001 lstDXFCodes)
          lstDataValues (cons (car lstData) lstDataValues))
    (RegApp (car lstData))
    (foreach DataItem (cdr lstData)
     (cond    ; Determine the data type and corrusponding DXF Code
      ((= (type DataItem) 'INT) 
       (if (> DataItem 32767)
        (setq intDataType  1071)                          ; Long    Data Type 
        (setq intDataType  1070)                          ; Integer Data Type
       )
      )                                                   
      ((= (type DataItem) 'REAL)(setq intDataType  1040)) ; Real Data Type
      ((= (type DataItem) 'STR) 
       (if (or (= DataItem "{")(= DataItem "}"))          ; String Data Type     
        (setq intDataType  1002)
        (setq intDataType  1000)
       )
      )
     )
     (setq lstDXFCodes   (cons intDataType lstDXFCodes)
           lstDataValues (cons DataItem    lstDataValues)
     )
    )
   )
   (setq safDXFCodes   (listToSafearray vlax-vbinteger
                        (reverse lstDXFCodes))                     
         safDataValues (listToSafeArray vlax-vbvariant
                        (reverse lstDataValues)))
   (errortrap (quote (vla-setXData objSelection safDXFCodes safDataValues)))
  )
 )
)

(defun ListToSafearray (symVariableType 
                             lstValues 
                             / 
                             safValues
                            )
 (setq safValues (vlax-make-safearray symVariableType (cons 0 (1- (length lstValues)))))
 (vlax-safearray-fill safValues lstValues)
)


(defun ErrorTrap (symFunction / objError result)
 (if (vl-catch-all-error-p
      (setq objError (vl-catch-all-apply
                     '(lambda (X)(set X (eval symFunction)))
                      (list 'result)))) 
  nil  
  (if result result 'T)
 )
)

(princ)

[peter]

Just to be complete, I recoded the above example to use the entmod method mentioned by blackbox for you LISP purists.

I had been monitoring Keans site and he was discussing removal of xdata and so I thought I would expose that functionality
to lisp using .net. That is why I tried to code it using .net. I haven't really studied removal of xdata using lisp or .net until today.

I was just playing around solving a programming puzzle and I solved it using .net and with blackbox's suggestion created the pure lisp version too.

I wanted to have a function that would remove xdata from a selection set of objects with a wildcard application name filter.

I like CAB's solution too... Its all good.

P=

;___________________________________________________________________________________________________________
;
; Command line Funtion to delete xdata from a selection set with a wildcard filter for applications names
; Using Entmod method (See CAB post on Swamp http://www.theswamp.org/index.php?topic=3080.msg38638#msg38638)
;___________________________________________________________________________________________________________

(defun C:XdataDelete (/ intCount ssSelections strWCFilter)
 (if (and 
      (setq strWCFilter (strcase (getstring "\nEnter Xdata Application WC Filter Name: ")))
      (princ "\nSelect objects to remove xdata from: ")
      (setq ssSelections (ssget))
     )
  (repeat (setq intCount (sslength ssSelections))
   (setq intCount (1- intCount))
   (xdatadelete (vlax-ename->vla-object (ssname ssSelections intCount)) strWCFilter)
  )  
 )
 (princ)
)

;___________________________________________________________________________________________________________
;
; Funtion to delete xdata from an object with a wildcard filter for applications names
; Using Entmod Method
; LISP Syntax: (xdatadelete obj "TEST#")
;___________________________________________________________________________________________________________

(defun XdataDelete (objSelection
                     strWCFilter
                     /
                     entSelection
                     lstApplictions
                     lstFiltered
                     strApplication
                    )
 (setq entSelection (vlax-vla-object->ename objSelection))
 (if (setq lstApplications (mapcar 'car (xdataget objSelection)))
  (foreach strApplication lstApplications
   (if (wcmatch strApplication strWCFilter)
    (setq lstFiltered (cons strApplication lstFiltered))
   )
  )
 )
 (if lstFiltered
  (apply 'and 
         (mapcar '(lambda (X)
                   (if (assoc -3 (entget entSelection (list X)))
                    (entmod (list (cons -1 entSelection) (list -3 (list X))))
                   )
                  )
                  lstFiltered
         )
  )
 )
)

;___________________________________________________________________________________________________________
;
; Funtion to get xdata from an object and return a list of sublists
; LISP Syntax: (xdataget obj) Returns '(("TEST1" 1 0)("TEST2" 2)("TESTA" "A"))
;___________________________________________________________________________________________________________


(defun XDataGet (objSelection 
                 / 
                 intCount 
                 intDXFCode
                 lstAll 
                 lstDXFCodes 
                 lstDataValues
                 lstSub 
                 safDXFCodes 
                 safDataValues
                )
 (if (and objSelection
         (errortrap (quote (vla-getxdata objSelection "" 'safDXFCodes 'safDataValues) )) 
          safDXFCodes
          safDataValues
         (setq lstDXFCodes   (vlax-safearray->list safDXFCodes)) 
         (setq lstDataValues (mapcar 'variant-value (vlax-safearray->list safDataValues)))  
         (setq intCount 0)
     )
  (foreach intDXFCode lstDXFCodes
   (if (= intDXFCode 1001)
    (if lstSub
     (setq lstAll (cons (reverse lstSub) lstAll)
           lstSub (list (nth intCount lstDataValues))
     )
     (setq lstSub (list (nth intCount lstDataValues)))  
    )
    (setq lstSub (cons (nth intCount lstDataValues) lstSub))   
   )
   (setq intCount (1+ intCount))
  )
 )
 (if lstSub (reverse (cons (reverse lstSub) lstAll)))
)

; General Error Trap.

(defun ErrorTrap (symFunction / objError result)
 (if (vl-catch-all-error-p
      (setq objError (vl-catch-all-apply
                     '(lambda (X)(set X (eval symFunction)))
                      (list 'result)))) 
  nil  
  (if result result 'T)
 )
)


(prin1)

[BlackBox]

... Anyone seen my posts (can't find them)?

[Edit] - Found them here. In the future, please post that you're moving the posts, and include a link to the new thread.

[Tommybluegrass]

Nice code - works very well with one exception. The registered apps stay with the object so (vl-cmdf "_.purge" "R" "" "N") is required to clean up or refresh the deletion.

[BlackBox]

Nice code - works very well with one exception. The registered apps stay with the object so (vl-cmdf "_.purge" "R" "" "N") is required to clean up or refresh the deletion.

Not really an issue here, as I use this, YMMV.

Cheers