黑体文字转轮廓！多段线中出头如何转成面域！

柱哥

工作中要用文字转轮廓，只是用AutoCAD中的txtexp后文字中还是有线条的

想做成的效果如下图

群里听说先转成面域后，并集可以做成，

上面粉色是面域，白色是多段线，因为图形自交无法产生面域。

下图中生成粉色图形求码！谢谢了！

Coffee..

试试燕秀工具箱的文字转线工具。

fan_zh

这个老生常谈的问题的
建议可以用楼上的工具或者第三方程序转换

hehoubin

1.将文字设置打印成空心文字命令 TEXTFILL   0
2.添加DXB文件的虚拟打印机
3.dxbin命令插入文件

柱哥

请问dxbin怎样控制文字位置与大小，有写好的码么，看看！

柱哥

在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

spiderman

xyp1964 发表于 2015-8-12 18:40

发个伪原码也好啊，不发伪原码，发个编程的思路也行啊，发个图片，真搞不懂是什么意思，可以认为你是在炫耀自己很NB吗？如果是要推广你的XXCAD工具箱，不妨大大方方的说一句，我的XXCAD工具箱里面有，去下载我的XXCAD工具箱吧，给个下载地址就完了。

llsheng_73

没能转成面域的那些地方多线段基本上都有回头线，想法处理一下就行没问题了

实际上回头线的实质是至少存在一个这样的顶点，它与其前后相邻的两个点所成的角度为0(txtexpt得到的二维多线段通常会有一些线存在这样的点而在region的时候被拒绝)。找到这样的点去掉后修改多线段，然后就能region成功了(除非是不需要的)，然后再union就不会缺胳膊少腿