[求助]：如何获得CAD中的字体名

WJQ6080

在LISP中如何才能获得CAD中的字体名，请大侠们指教！
效果应与CAD中的“文字式样”的字体名下拉列表框一致，万分感谢！！！

qjcpj

(defun c:test        (/ dxf st_shx st_big)
        (setq
                dxf        (tblsearch "style" (cdr (assoc '7 (entget (car (entsel))))))
        )
        (setq        st_shx (cdr (assoc '3 dxf))
                                st_big (cdr (assoc '4 dxf))
        )
        (princ "\n所选文字SHX字体为")
        (princ st_shx)
        (princ ";大字体为")
        (princ st_big)
        (princ)
)

WJQ6080

二楼的程序是确定选定文字的字体名，我想做一个下拉列表框，将CAD中能用的字体名列出以供选择，只是不知如何获得这些字体名，麻烦了。谢谢！！！

雨箭风刀

用 tblnext ,详细的看看帮助,自己琢磨一下

或 vla-get-

WJQ6080

想用vla-get,但书上说得太模糊，实在看不出具体用哪一个函数。还请明示！！！

雨箭风刀

The collection of all text styles in the drawing.

VBA class name:
AcadTextStyles

Create using:
N/A

Access via:
Document.TextStyles


To add a new member to the collection, use the Add method. To select a specific text style, use the Item method. To delete a specific text style, use the Delete method found on the TextStyle object.

Although the TextStyles collection inherits a Delete method, you cannot actually delete the collection. Attempting to delete the TextStyles collection will result in an error. The Delete method has been removed from the documentation for this collection.

There is no limit to the number of text styles that you can create in your drawing. However, there can be only one instance of the TextStyles Collection. The TextStyles Collection is predefined for each drawing. You can make multiple references to it by using the TextStyles property. Once done with an object, the reference is automatically released. Methods

Add

GetExtensionDictionary

GetXData

Item

SetXData  
Properties

Application

Count

Document

Handle

HasExtensionDictionary

ObjectID

ObjectName

OwnerID  
Events

Modified

WJQ6080

雨箭风刀老师，辛苦你了，花了这么大的精力，学生先谢了，
这是VBA的程序吧，可是我VBA没看过，还不懂，如果您没功夫就别写了，我同样感激的。
万分感谢！！！！！！

qjcpj

先用tblnext取出当前图形数据库中的字体样式名，将其导入一个表中，之后分别取字体样式名组码的3和4两项到另一表中，dcl取后一个表的数据就是楼主所要求的...

雨箭风刀

两个方法：
[php]
(vlax-for x (vla-get-TextStyles (vla-get-activedocument(vlax-get-acad-object)))
  (setq lst (cons (vla-get-name x) lst))
)
[/php] [php]
(while (setq x (tblnext "style" (not tlst)))
  (setq tlst (cons (cdr(assoc 2 x)) tlst))
)

[/php]

WJQ6080

大恩不言谢