[讨论]：关于WORD和CAD的接口问题

snsj

把WORD中的文字、表格等提取相关属性包括文字的大小、字型、颜色等和CAD之间的接口问题，希望高手能讨论一下～
这个是在一本书上找到的一个连接程序：

2. 
   
3. (vl-load-com)
   
4. (setq *AcadApp* (vlax-get-acad-object))
   
5. (setq *ModelSpace* (vla-get-ModelSpace
   
6.                      (vla-get-activedocument *AcadApp*)))
   
7. 
   
8. (if (equal nil mswc-wd100Words)
   
9.   (vlax-import-type-library
   
10.     :tlb-filename "C:/Microsoft Office/Office10/MSWORD.OLB"
    
11.     :methods-prefix "mswm-"
    
12.     :properties-prefix "mswp-"
    
13.     :constants-prefix "mswc-"
    
14.     )
    
15.   )
    
16. 
    
17. (setq msw (vlax-get-object "Word.Application"))
    
18.     (if(equal nil msw)
    
19.       (progn
    
20.         (setq msw (vlax-create-object "Word.Application"))
    
21.               (vla-put-visible msw :vlax-true)
    
22.                )
    
23.       )
    
24. 
    
25. (if(/= nil msw)
    
26.    (progn
    
27.        (setq docs (vlax-get-object "Word.Application"))
    
28.           (vla-put-visible msw :vlax-true)
    
29.              (setq docs (vla-get-documents msw))
    
30.                   (setq doc (mswm-add docs))
    
31.                       (setq paragraphs (mswp-get-paragraphs doc))
    
32.                          (vlax-for ent *ModelSpace*)
    
33. 
    
34.      
    
35. (if(equal(vla-get-ObjectName ent) "AcDbMText")
    
36.    (progn
    
37.      (setq text (vla-get-TextString ent)
    
38.            textpos  (vla-get-InsertionPoint ent)
    
39.            attyTextpos (vlax-variant-value textpos)
    
40.            textinfo
    
41.             (strcat
    
42.               (rtos(vlax-safearray-get-element
    
43.                      arrayTextpos
    
44.                      0
    
45.                      )
    
46.                    2
    
47.                    2
    
48.                    )
    
49.               "'"
    
50.               (rtos(vlax-safearray-get-element
    
51.                      arrayTextpos
    
52.                      1
    
53.                      )
    
54.                    2
    
55.                    2
    
56.                    )
    
57.               "'"
    
58.               (rtos(vlax-safearray-get-element
    
59.                      arrayTextpos
    
60.                      2
    
61.                      )
    
62.                    2
    
63.                    2
    
64.               )
    
65.               )
    
66.            )
    
67.      (setq pg(mswp-get-last paragraphs))
    
68.      (setq range (mswp-get-range pg)
    
69.            (mswp-put-bold range 1)
    
70.             (mswp-put-underline range mswc-wdUnderlineSingle)
    
71.            (mswm-InsertAfter
    
72.              range
    
73.              (strcat "AcDBMText at position" textinfo "\n")
    
74.              )
    
75.             (setq pg (mswp-get-last paragraphs))
    
76.            (setq range (mswp-get-range pg))
    
77.             (mswp-put-bold range 0)
    
78.            (mswp-put-bold range 0)
    
79.             (mswp-put-underline range mswc-wdUnderlineNone)
    
80.            (mswm-InsertAfter range (strcat text "\n\n"))
    
81.             )
    
82.      )
    
83.    )
    
84.      )
    
85.    (princ "\nNo Microsoft Word application found.\n")
    
86.    )

<br /> (vl-load-com)<br /> (setq *AcadApp* (vlax-get-acad-object))<br /> (setq *ModelSpace* (vla-get-ModelSpace<br />                      (vla-get-activedocument *AcadApp*)))<br /> <br /> (if (equal nil mswc-wd100Words)<br />   (vlax-import-type-library<br />     :tlb-filename "C:/Microsoft Office/Office10/MSWORD.OLB"<br />     :methods-prefix "mswm-"<br />     :properties-prefix "mswp-"<br />     :constants-prefix "mswc-"<br />     )<br />   )<br /> <br /> (setq msw (vlax-get-object "Word.Application"))<br />     (if(equal nil msw)<br />       (progn<br />         (setq msw (vlax-create-object "Word.Application"))<br />               (vla-put-visible msw :vlax-true)<br />                )<br />       )<br /> <br /> (if(/= nil msw)<br />    (progn<br />        (setq docs (vlax-get-object "Word.Application"))<br />           (vla-put-visible msw :vlax-true)<br />              (setq docs (vla-get-documents msw))<br />                   (setq doc (mswm-add docs))<br />                       (setq paragraphs (mswp-get-paragraphs doc))<br />                          (vlax-for ent *ModelSpace*)<br /> <br />      <br /> (if(equal(vla-get-ObjectName ent) "AcDbMText")<br />    (progn<br />      (setq text (vla-get-TextString ent)<br />            textpos  (vla-get-InsertionPoint ent)<br />            attyTextpos (vlax-variant-value textpos)<br />            textinfo<br />             (strcat<br />               (rtos(vlax-safearray-get-element<br />                      arrayTextpos<br />                      0<br />                      )<br />                    2<br />                    2<br />                    )<br />               "'"<br />               (rtos(vlax-safearray-get-element<br />                      arrayTextpos<br />                      1<br />                      )<br />                    2<br />                    2<br />                    )<br />               "'"<br />               (rtos(vlax-safearray-get-element<br />                      arrayTextpos<br />                      2<br />                      )<br />                    2<br />                    2<br />               )<br />               )<br />            )<br />      (setq pg(mswp-get-last paragraphs))<br />      (setq range (mswp-get-range pg)<br />            (mswp-put-bold range 1)<br />             (mswp-put-underline range mswc-wdUnderlineSingle)<br />            (mswm-InsertAfter<br />              range<br />              (strcat "AcDBMText at position" textinfo "\n")<br />              )<br />             (setq pg (mswp-get-last paragraphs))<br />            (setq range (mswp-get-range pg))<br />             (mswp-put-bold range 0)<br />            (mswp-put-bold range 0)<br />             (mswp-put-underline range mswc-wdUnderlineNone)<br />            (mswm-InsertAfter range (strcat text "\n\n"))<br />             )<br />      )<br />    )<br />      )<br />    (princ "\nNo Microsoft Word application found.\n")<br />    )