【e派】关于文本炸碎取外轮廓线步骤的探讨

lucas_3333

edata 发表于 2015-8-15 11:50
凑个热闹，思路是llsheng_73提到的折返线处理，用的老方法，region加union。

E大,能否贴出源码吗?
之前用过上些, 不是很完美, 主要是一些细节部分 ,还有位置会移动

tangjunasd58

;文字分解 这里有个也不是很好，
(defun c:WZFJ (/ bz ss n lvs lss lvp lvl lul ent luu)
     (setvar "cmdecho" 0) ;指令执行过程不响应
     (PRINC "\n文字分解功能")
(princ "\n-->请选取要分解的文字.....")
(setq ss (ssget ":S" '((0 . "*text"))))
(setvar "cmdecho" 0) (command "undo" "be") (setvar "mirrtext" 1)
(command "zoom" "e")
(setq bz (getvar "osmode")) (setvar "osmode" 0)
(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)) n 0)
(repeat (sslength ss)
  (setq ent (ssname ss n))
  (setq luu (strcat (getenv "Temp") "\\textb.wmf"))
  (command "mirror" ent "" lvp "@0,1" "y"
  "wmfout" luu ent "" "erase" ent ""
  "wmfin" luu 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) "") ;;end_command
  (setq n (+ n 1))
)
(command "zoom" "p")
(setvar "mirrtext" 0) (setvar "osmode" bz) (command "undo" "e")
(vl-file-delete luu)

     (PRINC "\n 文字分解完成！")(PRINC))

llsheng_73

1至7步可通过(C:txtexp)完成

edata

和txtexp有区别的是否镜像文本，如果不镜像，在文字倾斜的时候，能就得不到正确的结果，
不镜像的文字导入后是2D pl线，镜像后是直线，不镜像点位对不齐，union不出正确的结果。
镜像后处理重复线，但是速度会影响。。
个人觉得处理重复线是重点，怎样高速处理重复线。。。

xyp1964

edata 发表于 2015-8-16 12:27
和txtexp有区别的是否镜像文本，如果不镜像，在文字倾斜的时候，能就得不到正确的结果，
不镜像的文字导入 ...

2. 
   
3. ;; 两实体是否完全重合
   
4. (defun xyp-SameCheck-S1S2 (s1 s2)
   
5.   (if (equal (vl-remove-if  '(lambda (x) (member (car x) '(-1 5)))(entget s1))
   
6.                 (vl-remove-if  '(lambda (x) (member (car x) '(-1 5)))(entget s2))
   
7.       )
   
8.     t
   
9.     nil
   
10.   )
    
11. )

<br /> ;; 两实体是否完全重合<br /> (defun xyp-SameCheck-S1S2 (s1 s2)<br />   (if (equal (vl-remove-if  '(lambda (x) (member (car x) '(-1 5)))(entget s1))<br />                 (vl-remove-if  '(lambda (x) (member (car x) '(-1 5)))(entget s2))<br />       )<br />     t<br />     nil<br />   )<br /> )

xyp1964

2. 
   
3. ;; 直线格式化
   
4. (defun xyp-Line-DtFormat (s1 / rad p1 p2)
   
5.   (setq p1  (xyp-dxf 10 s1)
   
6.         p2  (xyp-dxf 11 s1)
   
7.         rad (angle p1 p2)
   
8.   )
   
9.   (if (or (equal rad pi 1e-3)
   
10.           (and (>= rad pi)
    
11.                (not (equal rad (* 2 pi) 1e-3))
    
12.           )
    
13.       )
    
14.     (xyp-SubUpd s1 '(10 11) (list p2 p1))
    
15.   )
    
16.   s1
    
17. )

<br /> ;; 直线格式化<br /> (defun xyp-Line-DtFormat (s1 / rad p1 p2)<br />   (setq p1  (xyp-dxf 10 s1)<br />         p2  (xyp-dxf 11 s1)<br />         rad (angle p1 p2)<br />   )<br />   (if (or (equal rad pi 1e-3)<br />           (and (>= rad pi)<br />                (not (equal rad (* 2 pi) 1e-3))<br />           )<br />       )<br />     (xyp-SubUpd s1 '(10 11) (list p2 p1))<br />   )<br />   s1<br /> )

jltx123456

edata 发表于 2015-8-15 11:50
凑个热闹，思路是llsheng_73提到的折返线处理，用的老方法，region加union。

码呢? 此主题怎么就无疾而终呢?

yyzhan12

对于院长来说, 这个不是难事吧

jltx123456

yyzhan12 发表于 2015-8-25 08:47
对于院长来说, 这个不是难事吧

确实不是难事 , 院长编程是厉害, 但是缺想法,  一个人想太累, 不好意思, 借用一下各位的思维

yyzhan12

jltx123456 发表于 2015-8-25 10:00
确实不是难事 , 院长编程是厉害, 但是缺想法,  一个人想太累, 不好意思, 借用一下各位的思维

哈哈, 原来这样啊