[求助]：VBA能否实现文字分解成多段线对象？

zf9568

AutoCAD的快捷工具中提供了这一功能，使用VL写成，不知哪位高手能够告知VBA的实现方法？
不甚感激。

lijiao

只要你知道VL如何达到目的，VBA就一定能做到。

zf9568

是呀，可是我对VL不了解，希望能得到指点。
多谢。

lijiao

将文字输出为WMF文件,然后再输入.

zf9568

将WMF文件作为光栅图像输入吗？
可是如何获得文字轮廓线？

lijiao

最初由 zf9568 发布
[B]将WMF文件作为光栅图像输入吗？
可是如何获得文字轮廓线？ [/B]

这是陈伯雄的程序：

2. 
   
3.   [FONT=courier new]
   
4. (Defun C:TextB (/ lvl lul lvp lvs lss ViewPL)
   
5.        (SetQ lvs (GetVar "viewsize")
   
6.              lss (GetVar "screensize")
   
7.        )
   
8.        (SetVar "cmdecho" 0)
   
9.        (Defun ViewPL ( / vi vw vh vc)
   
10.               (setq vi (* lvs (/ (Car lss) (Cadr lss)))
    
11.                     vc (GetVar "viewctr")
    
12.                     vw (list (- (car vc)  (* 0.5 vi))
    
13.                              (- (cadr vc) (* 0.5 lvs))
    
14.                        )
    
15.                     vh (list (+ (car vc)  (* 0.5 vi))
    
16.                              (+ (cadr vc) (* 0.5 lvs))
    
17.                        )
    
18.               )
    
19.               (List vw vh)
    
20.        )
    
21.        (PrinC "\n要分解的文字行: ")
    
22.        (SetQ ltl (SSGet)
    
23.              lvl (ViewPL)
    
24.              lul (List (Caar lvl) (Cadadr lvl))
    
25.              lvp (GetVar "viewctr")
    
26.        )
    
27.        (Command "mirror" ltl "" lvp "@0,1" "y"
    
28.                 "wmfout" "textb" ltl ""
    
29.                 "erase" ltl ""
    
30.                 "wmfin" "textb" lul "2" "" ""
    
31.                 "mirror" (EntLast) "" lvp "@0,1" "y"
    
32.                 "explode" (EntLast)
    
33.                 "erase" (ssget "p") "R" "W"
    
34.                         (polar (car lvl) (* 0.25 Pi)
    
35.                                (Max (Abs (/ lvs (Cadr lss)))
    
36.                                     (Abs (/ (* lvs
    
37.                                                (/ (Car lss) (Cadr lss))
    
38.                                             )
    
39.                                             (Car lss)
    
40.                                          )
    
41.                                      )
    
42.                                )
    
43.                         )
    
44.                         (cadr lvl)
    
45.                     ""
    
46.        )
    
47.        (SetVar "cmdecho" 1)(PrinC)
    
48. )
    
49.   [/FONT]
    

<br />   [FONT=courier new]<br /> (Defun C:TextB (/ lvl lul lvp lvs lss ViewPL)<br />        (SetQ lvs (GetVar "viewsize")<br />              lss (GetVar "screensize")<br />        )<br />        (SetVar "cmdecho" 0)<br />        (Defun ViewPL ( / vi vw vh vc)<br />               (setq vi (* lvs (/ (Car lss) (Cadr lss)))<br />                     vc (GetVar "viewctr")<br />                     vw (list (- (car vc)  (* 0.5 vi))<br />                              (- (cadr vc) (* 0.5 lvs))<br />                        )<br />                     vh (list (+ (car vc)  (* 0.5 vi))<br />                              (+ (cadr vc) (* 0.5 lvs))<br />                        )<br />               )<br />               (List vw vh)<br />        )<br />        (PrinC "\n要分解的文字行: ")<br />        (SetQ ltl (SSGet)<br />              lvl (ViewPL)<br />              lul (List (Caar lvl) (Cadadr lvl))<br />              lvp (GetVar "viewctr")<br />        )<br />        (Command "mirror" ltl "" lvp "@0,1" "y" <br />                 "wmfout" "textb" ltl ""<br />                 "erase" ltl ""<br />                 "wmfin" "textb" lul "2" "" ""<br />                 "mirror" (EntLast) "" lvp "@0,1" "y"<br />                 "explode" (EntLast) <br />                 "erase" (ssget "p") "R" "W"<br />                         (polar (car lvl) (* 0.25 Pi)<br />                                (Max (Abs (/ lvs (Cadr lss))) <br />                                     (Abs (/ (* lvs <br />                                                (/ (Car lss) (Cadr lss))<br />                                             ) <br />                                             (Car lss)<br />                                          )<br />                                      )<br />                                )<br />                         ) <br />                         (cadr lvl)<br />                     ""<br />        )<br />        (SetVar "cmdecho" 1)(PrinC)<br /> )<br />   [/FONT]<br />

zf9568

多谢赐教。