Using an ARX ActiveX server to update the block description from LISP

Free-Lancer

Using an ARX ActiveX server to update the block description from LISPBy Xiaodong Liang
Issue      
How can I update the Description Field in the Block Definition using lisp ? Using the Lisp entmod function does not seem to work.

Solution      
The only way to do this at present is to use the ActiveX server exposed in the adskUnSupp arx utility, the latest utility for AutoCAD 2013 is available at

ADN AutoCAD Utilities

With that ARX, and the following lisp code which loads the ARX module, connects to the ActiveX interface from adskUnSupp ARX, and loads it's type library to enable the Block Description Property to be set directly via a lisp function call.

2. ;assume the utilities are installed at
   
3. ; C:\Program Files\Autodesk\ADNUtilities2013_X64\AutoCADControls\
   
4. 
   
5. (defun RunAcadUnSupp (/ rtn )
   
6. (if (null (setq rtn (member "AsdkUnsupp2013.arx" (arx)))) (setq rtn (arxload
   
7. "asdkunsupp2007.arx")))
   
8. (if (null rtn)
   
9.    (progn
   
10.      (princ "\nAsdkUnsupp2013.arx Not Loaded, Exiting.")
    
11.      (exit)
    
12.    )
    
13. )
    
14. (vl-load-com)
    
15. (setq AcadApp (vlax-get-acad-object))
    
16. ;;; Change the Path to adskUnSupp2007 here ->
    
17. (setq unSupp_ARXPath "C:\\Program Files\\Autodesk\\ADNUtilities2013_X64\\AutoCADControls\\")
    
18. (if (null unsupM-AddAnonymousGroup)
    
19.     (if (findfile (strcat unSupp_ARXPath "AsdkUnsupp2013.arx"))
    
20.     (vlax-import-type-library
    
21.      :tlb-filename
    
22.      (strcat unSupp_ARXPath "AsdkUnsupp2013.arx")
    
23.      :methods-prefix
    
24.      "unsupM-"
    
25.      :properties-prefix
    
26.      "unsupP-"
    
27.      :constants-prefix
    
28.      "unsupC-"
    
29.     )
    
30.    (progn
    
31.      (alert (strcat "Exiting - Can't find "" unSupp_ARXPath
    
32. "asdkunsupp2007.arx" """))
    
33.      (exit)
    
34.    )
    
35. )
    
36. )
    
37. (setq unSuppX (vla-GetInterfaceObject acadApp "Asdkunsupp2007.Application.1"))
    
38. (setq AcadDoc (vla-Get-ActiveDocument AcadApp))
    
39. (setq UtilObj (vla-Get-Utility AcadDoc))
    
40. (setq Blocks (vla-Get-Blocks AcadDoc))
    
41. (vla-GetEntity UtilObj 'BlockRefObj 'selPt "\nSelect a Inserted Block: ")
    
42. (if (equal
    
43.     (setq ObjType (vla-Get-ObjectName BlockRefObj))
    
44.     "AcDbBlockReference"
    
45.      )
    
46.       (progn
    
47.      (setq BlkName (vla-Get-Name BlockRefObj))
    
48.      (setq BlkObject (vla-Item Blocks BlkName))
    
49.      (setq exBlkDescriptn (unsupP-Get-BlockDescription unSuppX BlkObject))
    
50.      (setq aNewDescriptn (getString T (strcat "\nEnter New Block
    
51. Description<" exBlkDescriptn ">:")))
    
52.      (if (and aNewDescriptn (not (equal aNewDescriptn "")))
    
53.         (unsupP-Put-BlockDescription unSuppX BlkObject aNewDescriptn)
    
54.      )  
    
55.       )
    
56.    )
    
57.    (CleanUpOnExit)
    
58. )
    
59. 
    
60. (defun CleanUpOnExit ()
    
61. 
    
62. (if BlockRefObj (progn (vlax-Release-Object BlockRefObj) (setq BlockRefObj
    
63. nil)))
    
64. (if Blocks (progn (vlax-Release-Object Blocks) (setq Blocks nil)))
    
65. (if UtilObj (progn (vlax-Release-Object UtilObj) (setq UtilObj nil)))
    
66. (if AcadDoc (progn (vlax-Release-Object AcadDoc) (setq AcadDoc nil)))
    
67. (if unSuppX (progn (vlax-Release-Object unSuppX) (setq unSuppX nil)))
    
68. (if AcadApp (progn (vlax-Release-Object AcadApp) (setq AcadApp nil)))
    
69. (princ)
    
70. )
    
71. 
    
72. (princ "\nRunAcadUnSupp, CleanUpOnExit loaded, type (RunAcadUnSupp), or
    
73. (CleanUpOnExit) to run.")
    
74. (princ)

;assume the utilities are installed at <br /> ; C:\Program Files\Autodesk\ADNUtilities2013_X64\AutoCADControls\ <br /> <br /> (defun RunAcadUnSupp (/ rtn ) <br /> (if (null (setq rtn (member "AsdkUnsupp2013.arx" (arx)))) (setq rtn (arxload <br /> "asdkunsupp2007.arx"))) <br /> (if (null rtn) <br />    (progn <br />      (princ "\nAsdkUnsupp2013.arx Not Loaded, Exiting.") <br />      (exit) <br />    ) <br /> ) <br /> (vl-load-com) <br /> (setq AcadApp (vlax-get-acad-object)) <br /> ;;; Change the Path to adskUnSupp2007 here -> <br /> (setq unSupp_ARXPath "C:\\Program Files\\Autodesk\\ADNUtilities2013_X64\\AutoCADControls\\") <br /> (if (null unsupM-AddAnonymousGroup) <br />     (if (findfile (strcat unSupp_ARXPath "AsdkUnsupp2013.arx")) <br />     (vlax-import-type-library <br />      :tlb-filename <br />      (strcat unSupp_ARXPath "AsdkUnsupp2013.arx") <br />      :methods-prefix <br />      "unsupM-" <br />      :properties-prefix <br />      "unsupP-" <br />      :constants-prefix <br />      "unsupC-" <br />     ) <br />    (progn <br />      (alert (strcat "Exiting - Can't find "" unSupp_ARXPath <br /> "asdkunsupp2007.arx" """)) <br />      (exit) <br />    ) <br /> ) <br /> ) <br /> (setq unSuppX (vla-GetInterfaceObject acadApp "Asdkunsupp2007.Application.1")) <br /> (setq AcadDoc (vla-Get-ActiveDocument AcadApp)) <br /> (setq UtilObj (vla-Get-Utility AcadDoc)) <br /> (setq Blocks (vla-Get-Blocks AcadDoc)) <br /> (vla-GetEntity UtilObj 'BlockRefObj 'selPt "\nSelect a Inserted Block: ") <br /> (if (equal <br />     (setq ObjType (vla-Get-ObjectName BlockRefObj)) <br />     "AcDbBlockReference" <br />      ) <br />       (progn <br />      (setq BlkName (vla-Get-Name BlockRefObj)) <br />      (setq BlkObject (vla-Item Blocks BlkName)) <br />      (setq exBlkDescriptn (unsupP-Get-BlockDescription unSuppX BlkObject)) <br />      (setq aNewDescriptn (getString T (strcat "\nEnter New Block <br /> Description<" exBlkDescriptn ">:"))) <br />      (if (and aNewDescriptn (not (equal aNewDescriptn ""))) <br />         (unsupP-Put-BlockDescription unSuppX BlkObject aNewDescriptn) <br />      )  <br />       ) <br />    ) <br />    (CleanUpOnExit) <br /> ) <br /> <br /> (defun CleanUpOnExit () <br /> <br /> (if BlockRefObj (progn (vlax-Release-Object BlockRefObj) (setq BlockRefObj <br /> nil))) <br /> (if Blocks (progn (vlax-Release-Object Blocks) (setq Blocks nil))) <br /> (if UtilObj (progn (vlax-Release-Object UtilObj) (setq UtilObj nil))) <br /> (if AcadDoc (progn (vlax-Release-Object AcadDoc) (setq AcadDoc nil))) <br /> (if unSuppX (progn (vlax-Release-Object unSuppX) (setq unSuppX nil))) <br /> (if AcadApp (progn (vlax-Release-Object AcadApp) (setq AcadApp nil))) <br /> (princ) <br /> ) <br /> <br /> (princ "\nRunAcadUnSupp, CleanUpOnExit loaded, type (RunAcadUnSupp), or <br /> (CleanUpOnExit) to run.") <br /> (princ)