- 积分
- 15341
- 明经币
- 个
- 注册时间
- 2002-2-4
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2003-4-3 12:33:00
|
显示全部楼层
Removes MTEXT formatting (供參考)
Having a reason to compare the value of groups of Mtext/Text in an Xref to
groups of Mtext/Text in the host drawing, I decided to attack the Mtext
formatting, in hopes of reducing it to a simple string equivalent. Tony said it
was difficult with AutoLisp, but I hope he was referring only to find *and*
replace algorithms. While risking public ridicule, I'd appreciate it if you
sages would test and comment (easy now, Tony).
;;===========================================================
;; UNFORMAT.LSP (c)2003, John F. Uhden, Cadlantic/CADvantage
;; v1.0 (04-01-03)
;; Removes MTEXT formatting with option to retain the "\\P" LineFeeds
;;
;; Arguments:
;; Mtext - either an Ename or VLA-Object
;; KeepLF - nil (discard LineFeeds) non-nil (retain LineFeeds)
;;
;; NOTES:
;; Only R15 or higher.
;; v1.0 is only the first attempt.
;; We can always embellish the code with additional options.
;; Yes, it can probably be sped up using integers, but this is legible.
;;
(defun UnFormat (Mtext KeepLF / Text Str)
(vl-load-com)
(cond
((= (type Mtext) 'VLA-Object))
((= (type Mtext) 'ENAME)
(setq Mtext (vlax-ename->vla-object Mtext))
)
(1 (setq Mtext nil))
)
(and
Mtext
(= (vlax-get Mtext 'ObjectName) "AcDbMText")
(setq Mtext (vlax-get Mtext 'TextString))
(setq Text "")
(while (/= Mtext "")
(cond
((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}`~]")
(setq Mtext (substr Mtext 3)
Text (strcat Text Str)
)
)
((wcmatch (substr Mtext 1 1) "[{}]")
(setq Mtext (substr Mtext 2))
)
((and KeepLF (wcmatch (strcase (substr Mtext 1 2)) "\\P"))
(setq Mtext (substr Mtext 3)
Text (strcat Text "\\P")
)
)
((wcmatch (strcase (substr Mtext 1 2)) "\\[LOP]")
(setq Mtext (substr Mtext 3))
)
((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
(setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext))))
)
((wcmatch (strcase (substr Mtext 1 2)) "\\S")
(setq Str (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
Text (strcat Text (vl-string-translate "#^\\" " " Str))
Mtext (substr Mtext (+ 4 (strlen Str)))
)
(print Str)
)
(1
(setq Text (strcat Text (substr Mtext 1 1))
Mtext (substr Mtext 2)
)
)
)
)
)
Text
)
--
John Uhden, Cadlantic/formerly CADvantage
http://www.cadlantic.com
Sea Girt, NJ |
|