Delete XData with a specified application name from a selected entity
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
Code:
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
Re: Delete XData with a specified application name from a selected entity
Quote:
Originally Posted by
peter
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
1 Attachment(s)
Re: Delete XData with a specified application name from a selected entity
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=
Code:
;___________________________________________________________________________________________________________
;
; 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)
1 Attachment(s)
Re: Delete XData with a specified application name from a selected entity
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=
Code:
;___________________________________________________________________________________________________________
;
; 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)
Re: Delete XData with a specified application name from a selected entity
... 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.
Re: Delete XData with a specified application name from a selected entity
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.
Re: Delete XData with a specified application name from a selected entity
Quote:
Originally Posted by
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.
Not really an issue here, as I use this, YMMV. :beer:
Cheers
