[求助]：如何获得所有style字型样式名的列表？

xyp1964

如何获得所有style字型样式名的列表？

(vla-get-TextStyles Object)说明不全。

zhynt

[php]
(defun dxf (code elist)
  (cdr (assoc code elist))
)
;;;
;;;  搜索图中所定义的字形，并形成两个表：表“stytab”和表“sty_zh”
;;;
(defun fdzx (/ sty1 sty2 first tab sm1 sm2)
  (setq zixchangdu 14)
  (setq xiaoziti 10)
  (setq daziti 10)
  (setq first T)
  (setq tab '())
  (setq stytab '())
  (setq sty_zh '())
  (while (setq sty1 (tblnext "style" first)) ;搜索图中字型
    (setq sm2_id nil)
    (if        (= first T)
      (setq first nil)
    )                                        ;end if
    (if        (/= sty1 nil)
      (progn
        (setq tab (cons sty1 tab))
        (setq sty1 (nth 0 tab))
        (if (= (setq sty2 (dxf 2 sty1)) "")
          (progn
            (setq sm2_id 2)
            (setq sty3 "形")
          )                                ;end progn
          (setq sty3 sty2)
        )                                ;end if
        (setq sty_n (strlen sty3))
        (if (< sty_n zixchangdu)
          (while (/= sty_n zixchangdu)
            (setq sty3 (strcat sty3 " "))
            (setq sty_n (1+ sty_n))
          )                                ; end while
        )                                ;end if
        (if (> sty_n zixchangdu)
          (setq sty3 (substr sty3 1 zixchangdu))
        )                                ;end if
        (setq sm1 (dxf 3 sty1))
        (if (and sm1 (/= sm1 ""))
          (progn
            (if        (wcmatch sm1 "*.shx,*.Shx,*.SHX")
              (progn
                (setq sm1_n (strlen sm1))
                (setq sm1 (substr sm1 1 (- sm1_n 4)))
              )                                ;end pr
            )                                ; if
            (if        (wcmatch sm1 "*.ttf,*.TTF,*.Ttf")
              (progn
                (setq sm1_n (strlen sm1))
                (setq sm1 (substr sm1 1 (- sm1_n 4)))
                (setq sm2_id 1)
              )                                ;pr
            )                                ;if
            (setq sm1_n (strlen sm1))
            (if        (< sm1_n xiaoziti)
              (while (/= sm1_n xiaoziti)
                (setq sm1 (strcat sm1 " "))
                (setq sm1_n (1+ sm1_n))
              )                                ; wh
            )                                ;if
            (if        (> sm1_n xiaoziti)
              (setq sm1 (substr sm1 1 xiaoziti))
            )                                ;if
          )                                ;pr
        )                                ;if
        (if (and (setq sm2 (dxf 4 sty1)) (/= sm2 ""))
          (progn
            (if        (wcmatch sm2 "*.shx,*.Shx,*.SHX")
              (progn
                (setq sm2_n (strlen sm2))
                (setq sm2 (substr sm2 1 (- sm2_n 4)))
              )
            )
            (setq sm2_n (strlen sm2))
            (if        (< sm2_n daziti)
              (while (/= sm2_n daziti)
                (setq sm2 (strcat sm2 " "))
                (setq sm2_n (1+ sm2_n))
              )
            )
            (if        (> sm2_n daziti)
              (setq sm2 (substr sm2 1 daziti))
            )
          )
          (if (= sm2 "")
            (progn
              (setq sm2 "未定义")
              (if (= sm2_id 1)
                (setq sm2 "WIN字体")
              )
              (if (= sm2_id 2)
                (setq sm2 "形文件")
              )
            )
          )
        )
        (setq stytab (cons sty2 stytab))
        (if (and sm2 (/= sm2 ""))
          (setq sty_zh (cons (strcat sty3 sm1 sm2) sty_zh))
          (setq sty_zh (cons (strcat sty3 sm1) sty_zh))
        )
      )
    )
  )
)
[/php]

本程序搜索图中所定义的所有字体以及形文件，并形成两个表：
样式表和所对应的字体表。

这是实际应用：

Free-Lancer

2. 
   
3. (defun getstyles (/ d r)
   
4.   (while (setq d (tblnext "style" (null d)))
   
5.     (setq
   
6.       r        (cons
   
7.           (list (cdr (assoc 2 d)) (cdr (assoc 3 d)) (cdr (assoc 4 d)))
   
8.           r
   
9.         )
   
10.     )
    
11.   )
    
12.   (reverse r)
    
13. )
    
14. (defun vl-getstyles (/ r)
    
15.   (vlax-map-collection
    
16.     (vlax-get-property
    
17.       (vlax-get-property (vlax-get-acad-object) 'activedocument)
    
18.       'textstyles
    
19.     )
    
20.     '(lambda (x)
    
21.        (setq r (cons (list (vla-get-name x)
    
22.                            (vla-get-fontfile x)
    
23.                            (vla-get-bigfontfile x)
    
24.                      )
    
25.                      r
    
26.                )
    
27.        )
    
28.      )
    
29.   )
    
30.   r
    
31. )

<br /> (defun getstyles (/ d r)<br />   (while (setq d (tblnext "style" (null d)))<br />     (setq<br />       r        (cons<br />           (list (cdr (assoc 2 d)) (cdr (assoc 3 d)) (cdr (assoc 4 d)))<br />           r<br />         )<br />     )<br />   )<br />   (reverse r)<br /> )<br /> (defun vl-getstyles (/ r)<br />   (vlax-map-collection<br />     (vlax-get-property<br />       (vlax-get-property (vlax-get-acad-object) 'activedocument)<br />       'textstyles<br />     )<br />     '(lambda (x)<br />        (setq r (cons (list (vla-get-name x)<br />                            (vla-get-fontfile x)<br />                            (vla-get-bigfontfile x)<br />                      )<br />                      r<br />                )<br />        )<br />      )<br />   )<br />   r<br /> )

它山之石

最初由 xyp1964 发布
[B]如何获得所有style字型样式名的列表？

(vla-get-TextStyles Object)说明不全。 [/B]

何为：“说明不全”？
俺就是　这样获得列表的：
[php]
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq styles (vla-get-TextStyles doc))

[/php]

xyp1964

最初由 它山之石 发布
[B]

何为：“说明不全”？
俺就是　这样获得列表的：
  (vl-load-com... [/B]

(setq styles (vla-get-TextStyles doc))
“styles”的内容到底是什么？
“#（VLA-OBJECT IAcadTextStyles 031906f4）”的真实内容如何得到？

3楼的不错：
简单修改就可用了
[php]
;;;获得所有style字型样式名的列表
(defun getstyles (/ lst d)
  (while (setq d (tblnext "style" (null d)))
    (setq lst (cons (dxf 2 d) lst))
  )
  (reverse lst)
lst
)
[/php]