See the top rated post in this thread. Click here

Results 1 to 7 of 7

Thread: Delete XData with a specified application name from a selected entity

  1. #1
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    0

    Default 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
    Last edited by peter; 2014-02-17 at 06:06 PM.
    AutomateCAD

  2. #2
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,714
    Login to Give a bone
    1

    Default Re: Delete XData with a specified application name from a selected entity

    Quote Originally Posted by peter View Post
    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
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3660, Core i9-12900K 5.2GHz, 64GB DDR5 RAM, PCIe 4.0 M.2 SSD (RAID 0), 16GB NVIDIA RTX A4000

  3. #3
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    1

    Default 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)
    Attached Files Attached Files
    Last edited by peter; 2015-06-05 at 06:01 PM.
    AutomateCAD

  4. #4
    Past Vice President / AUGI Volunteer peter's Avatar
    Join Date
    2000-09
    Location
    Honolulu HI
    Posts
    1,106
    Login to Give a bone
    1

    Default 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)
    Attached Files Attached Files
    Last edited by peter; 2015-06-05 at 06:06 PM.
    AutomateCAD

  5. #5
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,714
    Login to Give a bone
    1

    Default 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.
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3660, Core i9-12900K 5.2GHz, 64GB DDR5 RAM, PCIe 4.0 M.2 SSD (RAID 0), 16GB NVIDIA RTX A4000

  6. #6
    Active Member Tommybluegrass's Avatar
    Join Date
    2015-12
    Location
    Mississippi Gulf Coast, U.S.A.
    Posts
    74
    Login to Give a bone
    0

    Default 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.

  7. #7
    Administrator BlackBox's Avatar
    Join Date
    2009-11
    Posts
    5,714
    Login to Give a bone
    0

    Default Re: Delete XData with a specified application name from a selected entity

    Quote Originally Posted by Tommybluegrass View Post
    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
    "How we think determines what we do, and what we do determines what we get."

    Sincpac C3D ~ Autodesk Exchange Apps

    Computer Specs:
    Dell Precision 3660, Core i9-12900K 5.2GHz, 64GB DDR5 RAM, PCIe 4.0 M.2 SSD (RAID 0), 16GB NVIDIA RTX A4000

Similar Threads

  1. Lisp file to delete All Xdata from selected entities regardless app name
    By diaa.caliph423218 in forum Bridging the Gap: LISP -> .NET -> LISP
    Replies: 1
    Last Post: 2015-09-29, 08:33 PM
  2. command reactor selected entity
    By Serhan_BAKIR in forum AutoLISP
    Replies: 3
    Last Post: 2012-01-13, 01:10 PM
  3. Replies: 3
    Last Post: 2011-02-09, 04:29 PM
  4. Write XData to an entity
    By avinash00002002 in forum AutoLISP
    Replies: 1
    Last Post: 2007-04-29, 01:31 PM
  5. How can I write a Xdata to a new fresh entity
    By avinash00002002 in forum AutoLISP
    Replies: 1
    Last Post: 2007-04-13, 03:38 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •