[教学]：在AutoCAD中做三维文字...

wowoaicad · 发表于 2003-4-17 20:17:20

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

在AutoCAD中做三维文字...(陈伯雄）

1) 写字，例如用隶书体TTF
2) 提取文字线框，用附加程序进行
3) 删除不需要的线
4) 接合成多段线(Pedit-M-All-Y-J...)
5) 一起拉伸
6) 做必要的布尔运算，完成。
------------------------------------------------------------------
程序：
(Defun C:TextB (/ lvl lul lvp lvs lss ViewPL)
(SetQ lvs (GetVar "viewsize")
lss (GetVar "screensize")
)
(SetVar "cmdecho" 0)
(Defun ViewPL ( / vi vw vh vc)
(setq vi (* lvs (/ (Car lss) (Cadr lss)))
vc (GetVar "viewctr")
vw (list (- (car vc) (* 0.5 vi))
(- (cadr vc) (* 0.5 lvs))
)
vh (list (+ (car vc) (* 0.5 vi))
(+ (cadr vc) (* 0.5 lvs))
)
)
(List vw vh)
)
(PrinC "\n要分解的文字行: ")
(SetQ ltl (SSGet)
lvl (ViewPL)
lul (List (Caar lvl) (Cadadr lvl))
lvp (GetVar "viewctr")
)
(Command "mirror" ltl "" lvp "@0,1" "y"
"wmfout" "textb" ltl ""
"erase" ltl ""
"wmfin" "textb" lul "2" "" ""
"mirror" (EntLast) "" lvp "@0,1" "y"
"explode" (EntLast)
"erase" (ssget "p") "R" "W"
(polar (car lvl) (* 0.25 Pi)
(Max (Abs (/ lvs (Cadr lss)))
(Abs (/ (* lvs
(/ (Car lss) (Cadr lss))
)
(Car lss)
)
)
)
)
(cadr lvl)
""
)
(SetVar "cmdecho" 1)(PrinC)
)
----------------------------------------------
结果实例：

Kosilin · 发表于 2003-4-17 20:57:10

我看这样太麻烦吧?无须编程!
最好的方法是:1.输入汉字,设置好字体. 2.命令TXTEXP. 3.将多余的线条删掉,根据结构制作一个个的面域, 再EXT 就OK了!

xjc_sh · 发表于 2003-4-17 21:25:21

谢谢陈老师！！

又学了自已不知道的！

HJZ · 发表于 2003-4-18 12:32:05

同意2楼意见。

madayu · 发表于 2003-4-19 19:43:41

最初由 Kosilin 发布
[B]我看这样太麻烦吧?无须编程!
最好的方法是:1.输入汉字,设置好字体. 2.命令TXTEXP. 3.将多余的线条删掉,根据结构制作一个个的面域, 再EXT 就OK了! [/B]

TXTEXP是什么命令？我的CAD2002里怎么没有？

zhynt · 发表于 2003-4-19 19:59:40

这是扩展工具里的命令。你有没有装扩展工具呢？

mage · 发表于 2003-4-20 01:10:44

TXTEXP是什么命令？我的CAD2002里怎么没有？

东北人 · 发表于 2003-4-22 16:04:48

如何装CAD 的扩展命令谢谢

wowoaicad · 发表于 2003-4-22 16:20:10

最初由 Kosilin 发布
[B]我看这样太麻烦吧?无须编程!
最好的方法是:1.输入汉字,设置好字体. 2.命令TXTEXP. 3.将多余的线条删掉,根据结构制作一个个的面域, 再EXT 就OK了! [/B]

转贴一下陈先生的回答

直接用CAD的Express中的炸開文字命令Textxp炸開文字。
再使用BOUNDARY命令做出面組。
再伸！
看来您还不知道，您说的功能也是LISP程序，源程序在下面。
您可以比较一下，您不认为还是我的程序更简洁么，在同样的功能下...
;;
;;;
;;; By Dominic Panholzer
;;;
;;; TXTEXP.LSP
;;; Copyright ?1999 by Autodesk, Inc.
;;;
;;; Your use of this software is governed by the terms and conditions of the
;;; License Agreement you accepted prior to installation of this software.
;;; Please note that pursuant to the License Agreement for this software,
;;; "[c]opying of this computer program or its documentation except as
;;; permitted by this License is copyright infringement under the laws of
;;; your country. If you copy this computer program without permission of
;;; Autodesk, you are violating the law."
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;; ----------------------------------------------------------------
;;;
;;; External Functions:
;;;
;;; ACET-ERROR-INIT --> ACETUTIL.FAS Intializes bonus error routine
;;; ACET-ERROR-RESTORE --> ACETUTIL.FAS Restores old error routine
;;; ACET-GEOM-ZOOM-FOR-SELECT --> ACETUTIL.FAS Zoom boundry to include points given
;;; ACET-LAYER-LOCKED --> ACETUTIL.FAS Checks to see if layer is locked
;;; ACET-GEOM-PIXEL-UNIT --> ACETUTIL.FAS Size of pixel in drawing units
;;; ACET-GEOM-TEXTBOX --> ACETUTIL.FAS Returns the textbox for any text
;;; ACET-GEOM-MIDPOINT --> ACETUTIL.FAS Returns midpoint between two points
;;; ACET-GEOM-VIEW-POINTS --> ACETUTIL.FAS Returns corner points of screen or viewport
;;; ACET-STR-FORMAT --> ACETUTIL.ARX String builder
;;; ACET-WMFIN --> ACETUTIL.FAS Brings in WMF file
;;;
(defun c:txtexp (/ grplst getgname blknm FLTR GLST GDICT SS VIEW UPLFT TMPFIL TBX
TMPFIL CNT PT1 PT2 ENT TXT TXTYP PTLST ZM LOCKED GNAM vpna vplocked)
(acet-error-init
(list
(list "cmdecho" 0
"highlight" 1
"osmode" 0
"Mirrtext" 1
"limcheck" 0
)
T
)
)
; --------------------- GROUP LIST FUNCTION ----------------------
; This function will return a list of all the group names in the
; drawing and their entity names in the form:
; (( . ) ... ( . ))
; ----------------------------------------------------------------
(defun acet-txtexp-grplst (/ GRP ITM NAM ENT GLST)
(setq GRP (dictsearch (namedobjdict) "ACAD_GROUP"))
(while (setq ITM (car GRP)) ; While edata item is available
(if (= (car ITM) 3) ; if the item is a group name
(setq NAM (cdr ITM) ; get the name
GRP (cdr GRP) ; shorten the edata
ITM (car GRP) ; get the next item
ENT (cdr ITM) ; which is the ename
GRP (cdr GRP) ; shorten the edata
GLST ; store the ename and name
(if GLST
(append GLST (list (cons ENT NAM)))
(list (cons ENT NAM))
)
)
(setq GRP (cdr GRP)) ; else shorten the edata
)
)
GLST ; return the list
)
; ------------------- GET GROUP NAME FUNCTION --------------------
; This function returns a list of all the group names in GLST
; where ENT is a member. The list has the same form as GLST
; ----------------------------------------------------------------
(defun acet-txtexp-getgname (ENT GLST / GRP GDATA NAM NLST)
(if (and GLST (listp GLST))
(progn
(foreach GRP GLST
(setq GDATA (entget (car GRP)))
(foreach ITM GDATA ; step through the edata
(if (and
(= (car ITM) 340) ; if the item is a entity name
(eq (setq NAM (cdr ITM)) ENT) ; and the ename being looked for
)
(setq NLST ; store the ename and name
(if NLST
(append NLST (list (cons (car GRP) (cdr GRP))))
(list (cons (car GRP) (cdr GRP)))
)
)
)
)
)
)
)
NLST
)
; ----------------------------------------------------------------
; MAIN PROGRAM
; ----------------------------------------------------------------
(if (and ; Are we in plan view?
(equal (car (getvar "viewdir")) 0 0.00001)
(equal (cadr (getvar "viewdir")) 0 0.00001)
(> (caddr (getvar "viewdir")) 0)
)
(progn
(prompt "\nSelect text to be EXPLODED: ")
(Setq FLTR ''''((-4 . " (-4 . " (0 . "MTEXT")
(0 . "TEXT")
(-4 . "OR>")
(-4 . " (102 . "{ACAD_REACTORS") ; and not leader text
(-4 . "NOT>")
(-4 . "AND>")
)
GLST (acet-txtexp-grplst) ; Get all the groups in drawing
GDICT (if GLST
(dictsearch (namedobjdict) "ACAD_GROUP")
)
SS (ssget FLTR)
CNT 0
)
;; filter out the locked layers
(if SS
(setq SS (car (bns_ss_mod SS 1 T)))
) ;if
;; if we have anything left
(if SS
(progn
(setq CNT 0) ; Reset counter
(while (setq ENT (ssname SS CNT)) ; step through each object in set
(and
GLST ; if groups are present in the drawing
(setq GNAM (acet-txtexp-getgname ENT GLST)) ; and the text item is in one or more
(foreach GRP GNAM ; step through those groups
(command "_.-group" "_r" ; and remove the text item
(cdr GRP) ENT ""
)
)
)
(setq TBX (acet-geom-textbox (entget ENT) 0)) ; get textbox points
(setq TBX (mapcar ''''(lambda (x)
(trans x 1 0) ; convert the points to WCS
)
TBX
)
)
(setq PTLST (append PTLST TBX)) ; Build list of bounding box
; points for text items selected
(setq CNT (1+ CNT)) ; get the next text item
); while
(setq PTLST (mapcar ''''(lambda (x)
(trans x 0 1) ; convert all the points
) ; to the current ucs
PTLST
)
)
(if (setq ZM (acet-geom-zoom-for-select PTLST)) ; If current view does not contain
(progn ; all bounding box points
(setq ZM
(list
(list (- (caar ZM) (acet-geom-pixel-unit)) ; increase zoom area by
(- (cadar ZM) (acet-geom-pixel-unit)) ; one pixel width to
(caddar ZM) ; sure nothing will be lost
)
(list (+ (caadr ZM) (acet-geom-pixel-unit))
(+ (cadadr ZM) (acet-geom-pixel-unit))
(caddr (cadr zm))
)
)
)
(if (setq vpna (acet-currentviewport-ename))
(setq vplocked (acet-viewport-lock-set vpna nil))
);if
(command "_.zoom" "_w" (car ZM) (cadr ZM)) ; zoom to include text objects
)
)
(setq VIEW (acet-geom-view-points)
TMPFIL (strcat (getvar "tempprefix") "txtexp.wmf")
PT1 (acet-geom-midpoint (car view) (cadr view))
PT2 (list (car PT1) (cadadr VIEW))
)
(if (acet-layer-locked (getvar "clayer")) ; if current layer is locked
(progn
(command "_.layer" "_unl" (getvar "clayer") "") ; unlock it
(setq LOCKED T)
)
)
(command "_.mirror" SS "" PT1 PT2 "_y"
"_.WMFOUT" TMPFIL SS "")
(if (findfile tmpfil) ; Does WMF file exist?
(progn
(command "_.ERASE" SS "") ; erase the orignal text
(setq ss (acet-wmfin TMPFIL)) ; insert the WMF file
(command "_.mirror" ss "" PT1 PT2 "_y")
) ;progn
) ;if
(if LOCKED
(command "_.layer" "_lock" (getvar "clayer") "") ; relock if needed
) ;if
(if ZM (command "_.zoom" "_p")) ; Restore original view if needed
(if vplocked
(acet-viewport-lock-set vpna T) ;re-lock the viewport if needed.
);if
(prompt (acet-str-format "\n%1 text object(s) have been exploded to lines." CNT))
(prompt "\nThe line objects have been placed on layer 0.")
)
)
)
(prompt "\nView needs to be in plan (0 0 1).")
);if equal
(acet-error-restore) ; Retsore values
(princ)
)
(princ)

直接用CAD的Express中的炸開文字命令Textxp炸開文字。 
再使用BOUNDARY命令做出面組。 
再伸！ 
 
看来您还不知道，您说的功能也是LISP程序，源程序在下面。 
您可以比较一下，您不认为还是我的程序更简洁么，在同样的功能下... 
 
;; 
;;; 
;;; By Dominic Panholzer 
;;; 
;;; TXTEXP.LSP 
;;; Copyright ?1999 by Autodesk, Inc. 
;;; 
;;; Your use of this software is governed by the terms and conditions of the 
;;; License Agreement you accepted prior to installation of this software. 
;;; Please note that pursuant to the License Agreement for this software, 
;;; "[c]opying of this computer program or its documentation except as 
;;; permitted by this License is copyright infringement under the laws of 
;;; your country. If you copy this computer program without permission of 
;;; Autodesk, you are violating the law." 
;;; 
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. 
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF 
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC. 
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE 
;;; UNINTERRUPTED OR ERROR FREE. 
;;; 
;;; Use, duplication, or disclosure by the U.S. Government is subject to 
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer 
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
;;; (Rights in Technical Data and Computer Software), as applicable. 
;;; 
;;; ---------------------------------------------------------------- 
;;; 
;;; External Functions: 
;;; 
;;; ACET-ERROR-INIT --> ACETUTIL.FAS Intializes bonus error routine 
;;; ACET-ERROR-RESTORE --> ACETUTIL.FAS Restores old error routine 
;;; ACET-GEOM-ZOOM-FOR-SELECT --> ACETUTIL.FAS Zoom boundry to include points given 
;;; ACET-LAYER-LOCKED --> ACETUTIL.FAS Checks to see if layer is locked 
;;; ACET-GEOM-PIXEL-UNIT --> ACETUTIL.FAS Size of pixel in drawing units 
;;; ACET-GEOM-TEXTBOX --> ACETUTIL.FAS Returns the textbox for any text 
;;; ACET-GEOM-MIDPOINT --> ACETUTIL.FAS Returns midpoint between two points 
;;; ACET-GEOM-VIEW-POINTS --> ACETUTIL.FAS Returns corner points of screen or viewport 
;;; ACET-STR-FORMAT --> ACETUTIL.ARX String builder 
;;; ACET-WMFIN --> ACETUTIL.FAS Brings in WMF file 
;;; 
 
(defun c:txtexp (/ grplst getgname blknm FLTR GLST GDICT SS VIEW UPLFT TMPFIL TBX 
TMPFIL CNT PT1 PT2 ENT TXT TXTYP PTLST ZM LOCKED GNAM vpna vplocked) 
(acet-error-init 
(list 
(list "cmdecho" 0 
"highlight" 1 
"osmode" 0 
"Mirrtext" 1 
"limcheck" 0 
) 
T 
) 
) 
 
; --------------------- GROUP LIST FUNCTION ---------------------- 
; This function will return a list of all the group names in the 
; drawing and their entity names in the form: 
; (( . ) ... ( . )) 
; ---------------------------------------------------------------- 
 
(defun acet-txtexp-grplst (/ GRP ITM NAM ENT GLST) 
 
(setq GRP (dictsearch (namedobjdict) "ACAD_GROUP")) 
(while (setq ITM (car GRP)) ; While edata item is available 
(if (= (car ITM) 3) ; if the item is a group name 
(setq NAM (cdr ITM) ; get the name 
GRP (cdr GRP) ; shorten the edata 
ITM (car GRP) ; get the next item 
ENT (cdr ITM) ; which is the ename 
GRP (cdr GRP) ; shorten the edata 
GLST ; store the ename and name 
(if GLST 
(append GLST (list (cons ENT NAM))) 
(list (cons ENT NAM)) 
) 
) 
(setq GRP (cdr GRP)) ; else shorten the edata 
) 
) 
GLST ; return the list 
) 
 
; ------------------- GET GROUP NAME FUNCTION -------------------- 
; This function returns a list of all the group names in GLST 
; where ENT is a member. The list has the same form as GLST 
; ---------------------------------------------------------------- 
 
(defun acet-txtexp-getgname (ENT GLST / GRP GDATA NAM NLST) 
(if (and GLST (listp GLST)) 
(progn 
(foreach GRP GLST 
(setq GDATA (entget (car GRP))) 
(foreach ITM GDATA ; step through the edata 
(if (and 
(= (car ITM) 340) ; if the item is a entity name 
(eq (setq NAM (cdr ITM)) ENT) ; and the ename being looked for 
) 
(setq NLST ; store the ename and name 
(if NLST 
(append NLST (list (cons (car GRP) (cdr GRP)))) 
(list (cons (car GRP) (cdr GRP))) 
) 
) 
) 
) 
) 
) 
) 
NLST 
) 
 
; ---------------------------------------------------------------- 
; MAIN PROGRAM 
; ---------------------------------------------------------------- 
 
(if (and ; Are we in plan view? 
(equal (car (getvar "viewdir")) 0 0.00001) 
(equal (cadr (getvar "viewdir")) 0 0.00001) 
(> (caddr (getvar "viewdir")) 0) 
) 
 
(progn 
 
(prompt "\nSelect text to be EXPLODED: ") 
 
(Setq FLTR ''''((-4 . " (-4 . " (0 . "MTEXT") 
(0 . "TEXT") 
(-4 . "OR>") 
(-4 . " (102 . "{ACAD_REACTORS") ; and not leader text 
(-4 . "NOT>") 
(-4 . "AND>") 
) 
GLST (acet-txtexp-grplst) ; Get all the groups in drawing 
GDICT (if GLST 
(dictsearch (namedobjdict) "ACAD_GROUP") 
) 
SS (ssget FLTR) 
CNT 0 
) 
;; filter out the locked layers 
(if SS 
(setq SS (car (bns_ss_mod SS 1 T))) 
) ;if 
 
;; if we have anything left 
(if SS 
(progn 
(setq CNT 0) ; Reset counter 
(while (setq ENT (ssname SS CNT)) ; step through each object in set 
 
(and 
GLST ; if groups are present in the drawing 
(setq GNAM (acet-txtexp-getgname ENT GLST)) ; and the text item is in one or more 
(foreach GRP GNAM ; step through those groups 
(command "_.-group" "_r" ; and remove the text item 
(cdr GRP) ENT "" 
) 
) 
) 
 
(setq TBX (acet-geom-textbox (entget ENT) 0)) ; get textbox points 
 
(setq TBX (mapcar ''''(lambda (x) 
(trans x 1 0) ; convert the points to WCS 
) 
TBX 
) 
) 
 
(setq PTLST (append PTLST TBX)) ; Build list of bounding box 
; points for text items selected 
 
(setq CNT (1+ CNT)) ; get the next text item 
); while 
 
(setq PTLST (mapcar ''''(lambda (x) 
(trans x 0 1) ; convert all the points 
) ; to the current ucs 
PTLST 
) 
) 
 
(if (setq ZM (acet-geom-zoom-for-select PTLST)) ; If current view does not contain 
(progn ; all bounding box points 
(setq ZM 
(list 
(list (- (caar ZM) (acet-geom-pixel-unit)) ; increase zoom area by 
(- (cadar ZM) (acet-geom-pixel-unit)) ; one pixel width to 
(caddar ZM) ; sure nothing will be lost 
) 
(list (+ (caadr ZM) (acet-geom-pixel-unit)) 
(+ (cadadr ZM) (acet-geom-pixel-unit)) 
(caddr (cadr zm)) 
) 
) 
) 
(if (setq vpna (acet-currentviewport-ename)) 
(setq vplocked (acet-viewport-lock-set vpna nil)) 
);if 
(command "_.zoom" "_w" (car ZM) (cadr ZM)) ; zoom to include text objects 
) 
) 
 
(setq VIEW (acet-geom-view-points) 
TMPFIL (strcat (getvar "tempprefix") "txtexp.wmf") 
PT1 (acet-geom-midpoint (car view) (cadr view)) 
PT2 (list (car PT1) (cadadr VIEW)) 
) 
 
(if (acet-layer-locked (getvar "clayer")) ; if current layer is locked 
(progn 
(command "_.layer" "_unl" (getvar "clayer") "") ; unlock it 
(setq LOCKED T) 
) 
) 
 
(command "_.mirror" SS "" PT1 PT2 "_y" 
"_.WMFOUT" TMPFIL SS "") 
 
(if (findfile tmpfil) ; Does WMF file exist? 
(progn 
(command "_.ERASE" SS "") ; erase the orignal text 
(setq ss (acet-wmfin TMPFIL)) ; insert the WMF file 
(command "_.mirror" ss "" PT1 PT2 "_y") 
) ;progn 
) ;if 
 
 
(if LOCKED 
(command "_.layer" "_lock" (getvar "clayer") "") ; relock if needed 
) ;if 
 
(if ZM (command "_.zoom" "_p")) ; Restore original view if needed 
(if vplocked 
(acet-viewport-lock-set vpna T) ;re-lock the viewport if needed. 
);if 
(prompt (acet-str-format "\n%1 text object(s) have been exploded to lines." CNT)) 
(prompt "\nThe line objects have been placed on layer 0.") 
) 
) 
) 
(prompt "\nView needs to be in plan (0 0 1).") 
);if equal 
(acet-error-restore) ; Retsore values 
(princ) 
) 
 
 
(princ)

wardhowe · 发表于 2003-4-22 22:27:57

好复杂哦，都不想看，算了，这招还是不学了：）

无痕 · 发表于 2003-4-23 00:14:37

给文字加个thickness如何?不行么?:)

cqhh · 发表于 2003-5-19 18:57:34

但TXTEXP把文字炸开后，常有把文的某一笔给炸消失了，但不知有没有什么办法解决

hblp · 发表于 2003-5-24 22:58:05

按Kosilin []的方法，会做了，在txtexp后，炸开，将多余的线条删掉,根据结构制作一个面域时，我是用pline一步步描的 ,效果不太理想，更好就是用region将其转变为面域后再拉伸，谢谢学友指导！！

sgc706 · 发表于 2003-5-26 10:30:41

又学了几招，真好，十分感谢

zhl20020708 · 发表于 2003-5-31 18:18:26

高人太多了！

账号		自动登录	找回密码
密码			立即注册

[教学]：在AutoCAD中做三维文字...

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

回