- 积分
- 4592
- 明经币
- 个
- 注册时间
- 2012-12-27
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
修改优化以下代码,或重写,币少可以发加密的测试程序给我,达到要求可现金,费用合理。
文字分解功能,字分解成单线不完全, 我知道在这个基础可以用检查重线-删除重合的线-合并,这个步骤
;文字分解
(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))
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|