文字分解功能，有些字分解成单线不完全，
修改优化以下代码，或重写，币少可以发加密的测试程序给我，达到要求可现金，费用合理。文字分解功能，字分解成单线不完全， 我知道在这个基础可以用检查重线-删除重合的线-合并，这个步骤
;文字分解
(defun c:MX-WFJ (/ 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))
貌似已经有人研究过这个东西：
http://bbs.mjtd.com/thread-169097-1-1.html 没有人接吗 目前所知的文字爆破，其原理都是acad的wmf输出再导入生成的，因此结果都是一样的，中间的这些线段也都有。如果要不同的结果，就得重新写爆炸代码，估计难度很大。 加载XLRX_API:
(XLRX-WmfOut-In (car(entsel "\n选择文字:"))) 好好好！！！ 同样的用 GU_XL大师的变的成上面的，文字轮廓变大了，下面的是问题的代码出来的结果，就是中间有很多线段 tangjunasd58 发表于 2016-1-14 18:59 static/image/common/back.gif
同样的用 GU_XL大师的变的成上面的，文字轮廓变大了，下面的是问题的代码出来的结果，就是中间有很多线段
貌似可行,操作顺序如下:
MX-WFJ.LSP ==>文字分解
L2PL.LSP ==>将线转LWPOLYLINE
SD.LSP ==>删除图形上多余节点
Poly2Reg.lsp ==>聚合线(LWPOLYLINE)转面域
指令: _union ==>将面域联集 (defun c:L2PL (/ a ss di)
(setq a (getvar "peditaccept"))
(setvar "peditaccept" 1)
(if (and (setq ss (ssget '((0 . "LINE,*POLYLINE,ARC"))))
(or (setq di (getdist "\n输入模糊距离 <0>: "))
(setq di 0)
)
)
(command "_.pedit" "_m" ss "" "_j" di "")
)
(setvar "peditaccept" a)
(princ)
) ;;;删除图形上多余节点（同一直线上的多余节点及重复的节点）
;;;http://bbs.mjtd.com/thread-108745-1-1.html
;|
多谢多位论坛高手的指导，慢慢才把这个功能给磨出来。小弟是个初学者，可能写的不够简洁，希望大家给点意见，看看可不可以简化。
代码中有参考greatlmy 楼主，在http://bbs.mjtd.com/forum.php?mo ... &fromuid=202795发的表处理函数。先说声谢谢了。
|;
(defun c:sd(/ om ss l_length i j n mm z data new_list last_list m_list en en_data old_pt_num f_list b_list pt1 pt2 pt_1 pt_2 pt_3
pt_num ang1 ang2 ang_d new_en_data new_pt_num)
(SETVAR "CMDECHO" 0)
(setq om (getvar "osmode")) ;取得对像捕捉的位码
(setvar "osmode" 0) ;关掉对像捕捉
(setq ss (ssget'((0 . "LWPOLYLINE"))));选择多个对象
(setq l_length 0)
(repeat (sslength ss)
(setq i 0
j 0
n 0
z 0
mm 0
data (list '(0 0))
new_list (list '(0 0))
last_list (list '(0 0))
m_list (list '(0 0))
)
(setq en (ssname ss l_length));获取第“l_length”个对象的对象名
(setq en_data (entget en));获取对像列表
(setq old_pt_num (assoc 90 en_data))
(if (> (cdr old_pt_num) 2)
(progn
(setq b_list (list(car (reverse en_data))));获取对像数据中最后一个列表数据（群码 210）
;;;获取新的列表格式为每个节点坐标及40、41、42群码为一个列表，与其他节点的列表合为一个列表
(while (/= (nth j en_data) nil)
(if (=(car(nth j en_data)) 10)
(progn
(setq data (append (list(list (nth j en_data) (nth (+ j 1) en_data) (nth (+ j 2) en_data) (nth (+ j 3) en_data))) data))
(setq z (+ z 1))
(if (= z 1)
(setq f_list (carnth j en_data));获取对像数据中第一个节点坐标前的列表数据
);end if
);end progn
);end if
(setq j (+ j 1))
);end while
(setq data (cdr(reverse data)))
;;;判断两点是否相同，是则将相同点的列表删除
(while (/= (nth i data) nil)
(setq pt1(cdr (car (nth i data))))
(if (/= (nth (+ i 1) data) nil)
(setq pt2(cdr (car (nth (+ i 1) data))))
(setq pt2(cdr (car (nth 0 data))))
);end if
(if (or (>= (distance pt1 pt2) 0.0001) (/= (cdr (car (reverse (nth i data )))) 0 ))
(setq new_list (append (list (nth i data )) new_list))
);end if
(setq i (+ i 1))
);end while
(setq new_list (cdr(reverse new_list)))
;;;删除同一条线上的点
(while (/= (nth n new_list) nil)
(setq pt_1 (cdr (car (nth n new_list))))
(if (/= (nth (+ n 1) new_list) nil)
(setq pt_2 (cdr (car (nth (+ n 1) new_list))))
(setq pt_2 (cdr (car (nth 0 new_list))))
);end if
(if (/= (nth (+ n 2) new_list) nil)
(setq pt_3 (cdr (car (nth (+ n 2) new_list))))
(if (/= (nth (+ n 1) new_list) nil)
(setq pt_3 (cdr (car (nth 0 new_list))))
(setq pt_3 (cdr (car (nth 1 new_list))))
);end if
);end if
(setq ang1 (angle pt_2 pt_1))
(setq ang2 (angle pt_2 pt_3))
(setq ang_d (- ang2 ang1))
(if (and (>= (abs ang_d) 0.001) (>= (abs (- (abs ang_d) pi)) 0.001))
(if (/= (nth (+ n 1) new_list) nil)
(setq last_list (append (list (nth (+ n 1) new_list)) last_list))
(setq last_list (append (list (nth 0 new_list)) last_list))
);end if
);end if
(setq n (+ n 1))
);end while
(setq last_list (cdr(reverse last_list)))
(setq last_list (append (list(car (reverse last_list))) (reverse (cdr (reverse last_list)))));获得最终节点列表
(setq pt_num (length last_list));获取最后节点坐标的个数
;;;将各节点与40、41、42合成的列表分开并与其他节点列表合为统一个列表，格式为对像数据的列表格式
(while (/= (nth mm last_list) nil)
(setq nn 0)
(while (/= (nth nn (nth mm last_list)) nil)
(setq m_list (append (list(nth nn (nth mm last_list))) m_list))
(setq nn (+ nn 1))
);end while
(setq mm (+ mm 1))
);end while
(setq m_list (cdr(reverse m_list)))
;;;对像更新
(setq new_en_data (append f_list m_list b_list))
(setq new_pt_num (cons 90 pt_num))
(setq new_en_data (subst new_pt_num old_pt_num new_en_data))
(entmod new_en_data)
(setq l_length (+ l_length 1))
);end progn
);end if
);end repeat
(setvar "osmode" om)
(alert "多余节点删除完毕！")
)
(defun carnth (m l)
; 表取头,保留表L前面I-1个元素，函数返回新表
(if (= m (length l))
l
(progn
(setq l (reverse l)
m (- (length l) m 1)
l (cdrnth m l)
)
(reverse l)
)
)
)
(defun cdrnth (m l)
; 表取尾,去除表L后面I个元素，函数返回新表
(repeat (1+ m) (setq l (cdr l)))
)
页:
[1]
2