黑体文字转轮廓！多段线中出头如何转成面域！
本帖最后由 柱哥 于 2015-8-12 16:36 编辑工作中要用文字转轮廓，只是用Autocad中的txtexp后文字中还是有线条的
想做成的效果如下图
群里听说先转成面域后，并集可以做成，
上面粉色是面域，白色是多段线，因为图形自交无法产生面域。
下图中生成粉色图形求码！谢谢了！
本帖最后由 Coffee.. 于 2015-7-22 16:08 编辑
试试燕秀工具箱的文字转线工具。 这个老生常谈的问题的
建议可以用楼上的工具或者第三方程序转换 1.将文字设置打印成空心文字命令 TEXTFILL 0
2.添加DXB文件的虚拟打印机
3.dxbin命令插入文件 请问dxbin怎样控制文字位置与大小，有写好的码么，看看！ 本帖最后由 柱哥 于 2015-8-14 14:37 编辑
在AUTOCAD2008里运行差不多了，只是有的黑体字中间会掉，谁出手帮忙改改，谢谢了！
文字长度不要太长，太长有的字会出错，太长的文字分几段就好了。
(defun c:etext (/ bz ss n lvs lss lvp lvl lul en luu) ;文字抽轮廓
(setq lst (viewpnts))
(princ "\n文字抽轮廓,请选取文字")
(setq ss (ssget ":S" '((0 . "*text"))))
(command "undo" "be")
(setvar "mirrtext" 1)
(command "peditaccept" 1)
(setvar "draworderctl" 0)
(setvar "osmode" 0)
(setq n 0)
(repeat (sslength ss)
(setq ent (ssname ss n)
ssdata (entget ent)
lna (cdr (assoc 8 ssdata))
lih (* 0.02 (cdr (assoc 40 ssdata)))
)
(command "ucs" "e" ent)
(setq box (textbox ssdata)
p1(car box)
p2(cadr box)
p1(polar p1 (* 1.25 pi) 0.2)
p2(polar p2 (* 0.25 pi) 0.2)
)
(command "line" p1 p2 "")
(command "ucs" "")
(setq ss1(entlast)
enda (entget ss1)
at1(cdr (assoc 10 enda))
at2(cdr (assoc 11 enda))
)
(entdel ss1)
(command "zoom" "w" at1 at2)
;;; (setq lih (* 0.01 (- (cadr at2) (cadr at1))))
(setq lvs (getvar "viewsize")
lss (getvar "screensize")
lvp (getvar "viewctr")
lvl (list
(list (- (car lvp) (* 0.5 (* lvs (/ (car lss) (cadr lss)))))
(- (cadr lvp) (* 0.5 lvs))
)
(list (+ (car lvp) (* 0.5 (* lvs (/ (car lss) (cadr lss)))))
(+ (cadr lvp) (* 0.5 lvs))
)
)
lul (list (caar lvl) (cadadr lvl))
)
(setq luu (strcat (getenv "Temp") "\\text.wmf"))
;;; (command "mirror" ent "" lvp "@0,1" "y")
(command "wmfout" luu ent "")
(command "erase" ent "")
(command "clayer" lna "")
(command "wmfin" luu lul "2" "" "")
;;; (command "mirror" (entlast) "" lvp "@0,1" "y")
(command "explode" (entlast) "");;二维多段线
(setq ss1 (ssget "w" at1 at2))
(command "region" ss1 "")
(setq lan "PL-X"
lac "6"
)
(if(/= (tblsearch "layer" lan) nil) (command "layer" "c" lac lan "s" lan "")
(command "layer" "n" lan "c" lac lan "s" lan "")
)
(setq ss1 (ssget "w" at1 at2 '((0 . "region"))))
(command "chprop" ss1 "" "LA" "PL-X" "")
(command "clayer" "0" "")
(command "layer" "off" "PL-X" "")
(command "clayer" lna "")
(setq ss1 nil)
(if (setq ss1 (ssget "w" at1 at2))
(progn
(setq fss (ssget "w" at1 at2 '((0 . "POLYLINE"))))
(setq fn (sslength fss)
fk 0
)
(repeat fn
(setq enf (ssname fss fk))
(command "explode" enf)
(setq sel
(ssget "w"
at1
at2
'((-4 . "<NOT") (0 . "POLYLINE") (-4 . "NOT>"))
)
)
(command "-boundary" "a" "i" "n" "+x" "b" "n" sel "" "")
(setq ki -1
k(sslength Sel)
)
(repeat k
(setq en-line (ssname Sel (setq ki (1+ ki)))
LpLst (LAC-LR-Point en-line lih)
)
(command (car LpLst))
(command (cdr LpLst))
)
(command "")
(setq
ss1
(ssget "w"
at1
at2
'((-4 . "<NOT") (0 . "*POLYLINE") (-4 . "NOT>"))
)
)
(command "ERASE" ss1 "")
(setq
ss1
(ssget "w"
at1
at2
'((-4 . "<NOT") (0 . "POLYLINE") (-4 . "NOT>"))
)
)
(command "region" ss1 "")
(setq ss1 (ssget "w" at1 at2 '((0 . "region"))))
(command "chprop" ss1 "" "LA" "PL-X" "")
(setq fk (1+ fk))
)
)
)
(command "layer" "on" "PL-X" "")
(setq ss1 (ssget "w" at1 at2 '((8 . "PL-X"))))
(command "chprop" ss1 "" "LA" lna "")
(setq ss1 (ssget "w" at1 at2))
(command "union" ss1 "")
(setq ss3 (ssget "x" '((0 . "region"))))
(while (/= ss3 nil)
(command "explode" ss3)
(setq ss3 (ssget "x" '((0 . "region"))))
)
(setq ss1 (ssget "w" at1 at2))
(command "pedit" "m" ss1 "" "j" "0" "")
(setq ss1 (ssget "w" at1 at2))
(command "chprop" ss1 "" "LA" lna "")
(setq n (1+ n))
)
(command "zoom" "w" (car lst) (cadr lst))
(setvar "mirrtext" 0)
(command "peditaccept" 0)
(setvar "draworderctl" 3)
(command "purge" "la" "PL-X" "no")
(command "undo" "e")
(vl-file-delete luu)
(PRINC "\n文字轮廓完成！")
(PRINC)
)
(defun viewpnts (/ a b c d x) ;当前视窗左下角和右上角坐标
(setq b (getvar "viewsize")
c (car (getvar "screensize"))
d (cadr (getvar "screensize"))
a (* b (/ c d))
x (setq x (getvar "viewctr"))
x (trans x 1 2)
c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)
d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0)
c (trans c 2 1)
d (trans d 2 1)
)
(list c d)
)
(defun LAC-LR-Point (en d / a1 a2 a3 ang1 ang2)
(cond ((= (dxf en 0) "LINE")
(setq a1 (dxf en 10)
a2 (dxf en 11)
a3 (MidPoint a1 a2)
ang(angle a1 a2)
ang1 (+ ang (* pi 0.5))
ang2 (- ang (* pi 0.5))
a1 (polar a3 ang1 d)
a2 (polar a3 ang2 d)
)
(cons a1 a2)
)
((= (dxf en 0) "ARC")
(setq a3(dxf en 10);圆心
r (dxf en 40);半径
ang (* (+ (dxf en 50) (dxf en 51)) 0.5)
a1(polar a3 ang (- r d))
a2(polar a3 ang (+ r d))
)
(cons a1 a2)
)
((= (dxf en 0) "CIRCLE")
(setq a1 (dxf en 10)
a2 (polar a1 0 (+ d (dxf en 40)))
)
(cons a1 a2)
)
)
)
(defun dxf (ent i)
(cdr (assoc i (entget ent)))
)
(defun MidPoint (p1 p2)
(if (> 2 (length p1))
(list (* 0.5 (+ (car p1) (car p2)))
(* 0.5 (+ (cadr p1) (cadr p2)))
(* 0.5 (+ (caddr p1) (caddr p2)))
)
(list (* 0.5 (+ (car p1) (car p2)))
(* 0.5 (+ (cadr p1) (cadr p2)))
)
)
)
xyp1964 发表于 2015-8-12 18:40 static/image/common/back.gif
发个伪原码也好啊，不发伪原码，发个编程的思路也行啊，发个图片，真搞不懂是什么意思，可以认为你是在炫耀自己很NB吗？如果是要推广你的XXCAD工具箱，不妨大大方方的说一句，我的XXCAD工具箱里面有，去下载我的XXCAD工具箱吧，给个下载地址就完了。 本帖最后由 llsheng_73 于 2015-8-14 22:38 编辑
没能转成面域的那些地方多线段基本上都有回头线，想法处理一下就行没问题了
实际上回头线的实质是至少存在一个这样的顶点，它与其前后相邻的两个点所成的角度为0(txtexpt得到的二维多线段通常会有一些线存在这样的点而在region的时候被拒绝)。找到这样的点去掉后修改多线段，然后就能region成功了(除非是不需要的)，然后再union就不会缺胳膊少腿
页:
[1]