明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1005|回复: 0

[提问] 关于明经大神里的文字分解

[复制链接]
发表于 2020-8-16 09:01:42 | 显示全部楼层 |阅读模式
以下的代码出自明经不知道为什么会出错,求大神帮忙找到问题,谢谢!
文字分解
(defun c:G6(/ e entnam entnam2 entnam41 entnam42 entnam43 entnam44 entnam45 i list1 list2 list3 ltpoint newss num pent pixelsize ptlist ss tempfil viewcenter viewheigh)
  (setvar "cmdecho" 0)
  (setvar "osmode" 15359)
  (princ "\n★功能:将文字分解为曲线。\n提示:若出现变变换错误,请先将UCS设置为默认。\n")
  (command "undo" "be")
  (princ "\n请选取要分解为曲线的文字:")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if (not ss)
    (progn (princ "\n提示:未选中文字,程序退出!\n") (exit))
  )
  (setvar "mirrtext" 1)
  (setvar "osmode" 0)
  (setq i 0 pent (entlast) newss (ssadd))
  (repeat (setq num (sslength ss))
    (setq entnam (ssname ss i))
    (command "zoom" "o" entnam "")
    (setq PixelSize  (getvar "screensize") ;以像素为单位读取当前视口大小(X 和 Y)
          ViewHeigh  (getvar "viewsize") ;以图形单位测量当前视口中显示的视图的高度
          ViewCenter (getvar "viewctr") ;以UCS坐标表示当前视口中的视图的中心
          PtList     (list (list (- (car ViewCenter) (* 0.5 (* ViewHeigh (/ (car PixelSize) (cadr PixelSize)))))
                                 (- (cadr ViewCenter) (* 0.5 ViewHeigh))
                           ) ;视窗区左下角的坐标点
                           (list (+ (car ViewCenter) (* 0.5 (* ViewHeigh (/ (car PixelSize) (cadr PixelSize)))))
                                 (+ (cadr ViewCenter) (* 0.5 ViewHeigh))
                           ) ;视窗区右上角的坐标点
                     )
          LTPoint    (list (caar PtList) ;视窗区左下角的X坐标
                           (cadadr PtList) ;视窗区右上角的Y坐标
                     )
    )
    (setq TempFil (strcat (getenv "Temp") "\\textb.wmf"))
    (command "mirror" entnam "" ViewCenter "@0,1" "y") ;以Y轴镜像
    (command "wmfout" TempFil entnam "" "erase" entnam "" "wmfin" TempFil LTPoint "2.0" "" "")
    (command "mirror" (entlast) "" ViewCenter "@0,1" "y") ;以Y轴镜像
    (setq entnam2 (vlax-ename->vla-object (entlast)))
    (setq list1        (vlax-safearray->list (vlax-variant-value (vla-explode entnam2)))
          list2        nil
          list3        nil
    )
    (foreach entnam3 list1
      (if (eq (vla-get-ObjectName entnam3) "AcDbLine")
        (progn (setq entnam41 (vlax-curve-getpointatparam entnam3 (/ (vlax-curve-getendparam entnam3) 2.0))
                     entnam42 (strcat (rtos (car entnam41) 2 8) (rtos (cadr entnam41) 2 8))
               )
               (if (setq entnam43 (assoc entnam42 list3))
                 (progn (vla-delete entnam3) (vla-delete (cadr entnam43)))
                 (setq list3 (cons (list entnam42 entnam3) list3))
               )
        )
        (progn (setq list2 (append (vlax-safearray->list (vlax-variant-value (vla-explode entnam3))) list2))
               (vla-delete entnam3)
        )
      )
    )
    (foreach entnam3 list2
      (if (eq (vla-get-length entnam3) 0.0)
        (if (not (vlax-erased-p entnam3))
          (vla-delete entnam3)
        )
        (progn (setq entnam41 (vlax-curve-getstartpoint entnam3)
                     entnam42 (strcat (rtos (car entnam41) 2 8) (rtos (cadr entnam41) 2 8))
                     entnam41 (vlax-curve-getendpoint entnam3)
                     entnam44 (strcat entnam42 (rtos (car entnam41) 2 8) (rtos (cadr entnam41) 2 8))
                     entnam45 (strcat (rtos (car entnam41) 2 8) (rtos (cadr entnam41) 2 8) entnam42)
               )
               (if (or (setq entnam43 (assoc entnam44 list3)) (setq entnam43 (assoc entnam45 list3)))
                 (progn        (if (not (vlax-erased-p entnam3))
                          (vla-delete entnam3)
                        )
                        (if (not (vlax-erased-p (cadr entnam43)))
                          (vla-delete (cadr entnam43))
                        )
                 )
                 (setq list3 (cons (list entnam44 entnam3) list3))
               )
        )
      )
    )
    (vla-delete entnam2)
    (setq i (1+ i))
    (command "zoom" "p")
    (vl-file-delete TempFil)
  )
  (while (setq e (entnext pent)) (setq newss (ssadd e newss) pent e))
  (if (> (sslength newss) 0)
    (progn
      (if (tblsearch "layer" "layer3")
(vl-cmdf "_change" newss "" "p" "la" "layer3" "c" "bylayer" "")
(progn
   (vl-cmdf "-layer" "n" "layer3" "c" "bylayer" "layer3" "")
   (vl-cmdf "_change" newss "" "p" "la" "layer3" "c" "bylayer" "")
)
      )
      (vl-cmdf "_.pedit" "M" newss "" "J" 0 "")
    )
  )
  (setvar "CMDECHO" 1)
  (princ)
  (setvar "mirrtext" 0)
  (setvar "osmode" 15359)
  (command "undo" "e")
  (princ (strcat "\n提示:共将" (itoa num) "个文字对象成功分解为曲线。\n"))
  (princ)
)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-5-18 00:03 , Processed in 0.195139 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表