- ;获取所有字体样式
- (defun EF:Style-getAllTextStyles (
- /
- TextStyles lstFonts
- Typeface Bold Italic CharSet PitchAndFamily
- )
- (setq TextStyles (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'TextStyles))
- (vlax-for TextStyle TextStyles
- (vla-getFont TextStyle 'Typeface 'Bold 'Italic 'CharSet 'PitchAndFamily)
- (setq lstFonts (cons
- (list
- (vla-get-Name TextStyle)
- (vla-get-FontFile TextStyle)
- (vla-get-BigFontFile TextStyle)
- Typeface
- (vla-get-Height TextStyle)
- (vla-get-Width TextStyle)
- (vla-get-ObliqueAngle TextStyle)
- )
- lstFonts
- )
- )
- )
- (reverse lstFonts)
- )
- ;;167.7 [功能] Entmake居中单行文字
- (defun EntmakeText (PT STR Textheigh style)
- (entmakeX
- (list '(0 . "TEXT")
- (cons 1 str)
- (cons 10 pt)
- (cons 40 Textheigh)
- (cons 11 pt)
- (cons 7 style)
- (cons 72 1)
- (cons 73 2)
- )
- )
- )
- (setq i 0)
- (foreach a (EF:Style-getAllTextStyles)
- (EntmakeText (getpoint"\n请点击位置:") "区123" 30 (car a))
- (setq i (1+ i)) (print i)
- )
- (princ)
- ;(nth 20 (EF:Style-getAllTextStyles))
|