学习文本运算遇到的问题：多行文本运算缺陷

xyz2009xyz · 发表于 2010-7-19 01:30:00

程序为网上朋友源码，学习文本运算遇到的问题：添加了能对多行文本类型数字运算，但修改后（修改在文中已注释）多行文本运算缺陷--如果第一个选的为多行文本数字，插入时结果数字旋转了一定的角度，怎么修改，请大虾指教，看了好久没看透

谢谢

;;;说明
(alert "提醒:
\n请首先设置好输精度<小数点位数>,在绘图的过程中可随时用命令JD设置精度。
\n命令"+ - * /"分别代表对所选择的数字求和差积商。
\n其中"- /" 则是以你第一个选到的数字文本为被减数和被除数。
\n命令".."(点点)代表对所选择的数字文本统一加减乘除某个数，默认为1。
\n命令"TJ"代表对所选择的数字文本进行数学统计。
\n所有生成的新文本均与第一个选到的数字文本的样式相同(除角度外)。"
)
;;;定义了一个全局变量为精度
(defun C:JD (/ )
(prompt "\n请输入精度,直接回车则为系统精度:")
(initget 4)
(if (setq PRECISION (getint))
(princ)
(setq PRECISION (getvar "LUPREC"))
)
)
(C:JD)
;;;加
(defun C:+ (/ key sel ins first numlst result)
(while (common1)
(setq result (apply '+ (cadr numlst)))
(common2)
)
(princ)
)
;;;减
(defun C:- (/ key sel ins first numlst result)
(while (common1)
(setq result (apply '- (cadr numlst)))
(common2)
)
(princ)
)
;;;乘
(defun C:* (/ key sel ins first numlst result)
(while (common1)
(setq result (apply '* (cadr numlst)))
(common2)
)
(princ)
)
;;;除
(defun C:/ (/ key sel ins first numlst result)
(while (common1)
(setq result (apply '/ (cadr numlst)))
(common2)
)
(princ)
)
;;;所有数字都加减乘除某个数
(defun C:.. (/ key op sel ins first numlst result)
(while (setq sel (ssget '((0 . "TEXT")))) ;;修改为 (while (setq sel (ssget '((0 . "TEXT,MTEXT"))))
(setq first (ssname sel 0))
(setq Numlst (sel->list sel))
(initget 1 "+ - * /")
(setq key (getkword "\n请输入加减乘除符号<+ - * />:"))
(initget 2)
(if (null (setq op (getreal "\n请输入操作数<默认为1>:")))
(setq op 1.0)
)
(all-cal numlst key op)
)
(princ)
)
;;;
(defun all-cal (result sym op / lst old new)
(foreach n (car numlst)
(setq lst (entget n))
(setq old (atof (cdr (assoc 1 lst))))
(setq new (eval (cons (read sym) (list old op))))
(setq new (cons 1 (rtos new (getvar "LUNITS") PRECISION)))
(setq lst (subst new (assoc 1 lst) lst))
(entmod lst)
)
)
;;;选择和插入点
(defun common1 ()
(and
(setq sel (ssget '((0 . "TEXT"))));;修改为 (while (setq sel (ssget '((0 . "TEXT,MTEXT"))))
(null (initget 0 "Yes No"))
(if (setq key (getkword "\n是否保留原数字Yes,No?<默认不保留>:"))
(setq key "Yes")
(setq key "No")
)
(setq first (ssname sel 0))
(setq Numlst (sel->list sel))
)
)
;;;做文字或者更新文字
(defun common2 ()
(setq result (rtos result (getvar "LUNITS") PRECISION))
(if (= key "No")
(if (setq ins (getpoint "\n请输入插入点:"))
(make-text first result ins)
)
(update-text first result)
)
)
;;;选择集合转化成数字列表
(defun sel->list (sel / i ent lst num Els nls)
(setq i 0)
(repeat (sslength sel)
(setq ent (ssname sel i))
(setq lst (entget ent))
(setq num (atof (cdr (assoc 1 lst))))
(setq Els (cons ent Els))
(setq Nls (cons num Nls))
(setq i (1+ i))
)
(list
(reverse Els)
(reverse Nls)
)
)
;;;创建新文字,在指定点插入
(defun make-text (first string inspt / remove txtlst lst)
(setq remove (list -1 330 5 1 10 11 50))
(setq txtlst (entget first))
(foreach n txtlst
(if (not (member (car n) remove))
(setq lst (cons n lst))
)
)
(setq lst (cons (cons 1 string) lst))
(setq lst (cons (cons 10 inspt) lst))
(setq lst (cons (cons 11 inspt) lst))
(setq lst (reverse lst))
(cdr (assoc 40 (entmake lst)))
)
;;;保留文字,仅更新内容
(defun update-text (ent string / txtlst)
(setq txtlst (entget ent))
(setq txtlst (subst (cons 1 string) (assoc 1 txtlst) txtlst))
(entmod txtlst)
)
;;;统计数字文本
(defun C:tj (/ un sel ins tollst numlst first data len ang HIG j n m)
(setq un (getvar "LUNITS"))
(while (and (setq sel (ssget '((0 . "TEXT"))));;修改为 (while (setq sel (ssget '((0 . "TEXT,MTEXT"))))
(setq ins (getpoint "\n请输入插入点:")))
(princ "\n统计正在进行......")
(setq tollst (sel->list sel))
(setq numlst (cadr tollst))
(setq first (caar tollst))
(setq data (STAT numlst))
(setq len (strcat (caar data) (itoa (cdar data))))
(setq HIG (* (make-text first len ins) 1.5))
(setq ang (* Pi -0.5))
(setq j 1)
(repeat 4
(setq n (nth j data))
(setq m (strcat (car n) (rtos (cdr n) un PRECISION)))
(make-text first m (polar ins ang (* j HIG)))
(setq j (1+ j))
)
(princ "\n统计已经完成!")
)
(princ)
)
;;;统计函数
(defun STAT (numlst / len sum ave var sqr std)
(setq len (length numlst)) ;样本数目
(setq sum (apply '+ numlst)) ;和
(setq ave (/ sum len)) ;均值
(setq var (mapcar '(lambda (x) (* (- x ave) (- x ave))) numlst))
;差平方
(setq sqr (/ (apply '+ var) len)) ;方差 variance
(setq std (sqrt sqr)) ;标准差
(list
(cons "样本数......" len)
(cons "总和........" sum)
(cons "平均值......" ave)
(cons "方差........" sqr)
(cons "标准差......" std)
)
)

;;;说明
(alert "提醒:
       \n请首先设置好输精度<小数点位数>,在绘图的过程中可随时用命令JD设置精度。
       \n命令"+ - * /"分别代表对所选择的数字求和差积商。
       \n其中"- /" 则是以你第一个选到的数字文本为被减数和被除数。
       \n命令".."(点点)代表对所选择的数字文本统一加减乘除某个数，默认为1。
       \n命令"TJ"代表对所选择的数字文本进行数学统计。
       \n所有生成的新文本均与第一个选到的数字文本的样式相同(除角度外)。"
)
;;;定义了一个全局变量为精度
(defun C:JD (/ )
  (prompt "\n请输入精度,直接回车则为系统精度:")
  (initget 4)
  (if (setq PRECISION (getint))
    (princ)
    (setq PRECISION (getvar "LUPREC"))
  ) 
)
(C:JD)  
;;;加
(defun C:+ (/ key sel ins first numlst result)
  (while (common1)
    (setq result (apply '+ (cadr numlst)))
    (common2)          
  )
  (princ)
)
;;;减
(defun C:- (/ key sel ins first numlst result)
  (while (common1)
    (setq result (apply '- (cadr numlst)))
    (common2)          
  )
  (princ)
)
;;;乘
(defun C:* (/ key sel ins first numlst result)
  (while (common1)
    (setq result (apply '* (cadr numlst)))
    (common2)          
  )
  (princ)
)
;;;除
(defun C:/ (/ key sel ins first numlst result)
  (while (common1) 
    (setq result (apply '/ (cadr numlst)))
    (common2)          
  )
  (princ)
)
;;;所有数字都加减乘除某个数
(defun C:.. (/ key op sel ins first numlst result)
  (while (setq sel (ssget '((0 . "TEXT")))) ;;修改为 (while (setq sel (ssget '((0 . "TEXT,MTEXT")))) 
    (setq first  (ssname sel 0))
    (setq Numlst (sel->list sel))
    (initget 1 "+ - * /")
    (setq key (getkword "\n请输入加减乘除符号<+ - * />:"))
    (initget 2)
    (if (null (setq op (getreal "\n请输入操作数<默认为1>:")))
      (setq op 1.0)
    )        
    (all-cal numlst key op)          
  )
  (princ)
)
;;;
(defun all-cal (result sym op / lst old new)
  (foreach n (car numlst)
    (setq lst (entget n))
    (setq old (atof (cdr (assoc 1 lst))))
    (setq new (eval (cons (read sym) (list old op))))
    (setq new (cons 1 (rtos new (getvar "LUNITS") PRECISION)))
    (setq lst (subst new (assoc 1 lst) lst))
    (entmod lst)
  )
)
;;;选择和插入点
(defun common1 ()
  (and 
    (setq sel (ssget '((0 . "TEXT"))));;修改为 (while (setq sel (ssget '((0 . "TEXT,MTEXT"))))
    (null (initget 0 "Yes No"))
    (if (setq key (getkword "\n是否保留原数字Yes,No?<默认不保留>:"))
      (setq key "Yes")
      (setq key "No")
    )  
    (setq first  (ssname sel 0))
    (setq Numlst (sel->list sel))
  )
)
;;;做文字或者更新文字
(defun common2 ()
  (setq        result (rtos result (getvar "LUNITS") PRECISION))  
  (if (= key "No")
    (if (setq ins (getpoint "\n请输入插入点:"))
      (make-text first result ins)
    )
    (update-text first result)
  )
)
;;;选择集合转化成数字列表
(defun sel->list (sel / i ent lst num Els nls)
  (setq i 0)
  (repeat (sslength sel)
    (setq ent (ssname sel i))
    (setq lst (entget ent))
    (setq num (atof (cdr (assoc 1 lst))))
    (setq Els (cons ent Els))
    (setq Nls (cons num Nls))
    (setq i (1+ i))
  )
  (list
    (reverse Els)
    (reverse Nls)
  )
)  
;;;创建新文字,在指定点插入
(defun make-text (first string inspt / remove txtlst lst)
  (setq remove (list -1 330 5 1 10 11 50))
  (setq txtlst (entget first))
  (foreach n txtlst
    (if (not (member (car n) remove))
      (setq lst (cons n lst))
    )
  )  
  (setq lst (cons (cons 1 string) lst))
  (setq lst (cons (cons 10 inspt) lst))
  (setq lst (cons (cons 11 inspt) lst))
  (setq lst (reverse lst))
  (cdr (assoc 40 (entmake lst)))
)
;;;保留文字,仅更新内容
(defun update-text (ent string / txtlst)
  (setq txtlst (entget ent))
  (setq txtlst (subst (cons 1 string) (assoc 1 txtlst) txtlst))
  (entmod txtlst)
)
;;;统计数字文本
(defun C:tj (/ un sel ins tollst numlst first data len ang HIG j n m)
  (setq un (getvar "LUNITS"))
  (while (and (setq sel (ssget '((0 . "TEXT"))));;修改为 (while (setq sel (ssget '((0 . "TEXT,MTEXT"))))
              (setq ins (getpoint "\n请输入插入点:")))
    (princ "\n统计正在进行......")
    (setq tollst (sel->list sel))
    (setq numlst (cadr tollst))
    (setq first  (caar tollst))
    (setq data   (STAT numlst))
    (setq len (strcat (caar data) (itoa (cdar data))))
    (setq HIG (* (make-text first len ins) 1.5))
    (setq ang (* Pi -0.5))
    (setq j 1)
    (repeat 4
      (setq n (nth j data))
      (setq m (strcat (car n) (rtos (cdr n) un PRECISION)))
      (make-text first m (polar ins ang (* j HIG)))
      (setq j (1+ j))
    )
    (princ "\n统计已经完成!")
  )
  (princ)
)
;;;统计函数
(defun STAT (numlst / len sum ave var sqr std)
  (setq len (length numlst))                        ;样本数目
  (setq sum (apply '+ numlst))                      ;和
  (setq ave (/ sum len))                            ;均值
  (setq var (mapcar '(lambda (x) (* (- x ave) (- x ave))) numlst))
                                                    ;差平方
  (setq sqr (/ (apply '+ var) len))                 ;方差  variance 
  (setq std (sqrt sqr))                             ;标准差
  (list
    (cons "样本数......" len)
    (cons "总和........" sum)
    (cons "平均值......" ave)
    (cons "方差........" sqr)
    (cons "标准差......" std)
  )
)

修改后程序见附件，加载后+-×/启动运算

jialiang168 · 发表于 2010-7-19 01:42:00

嘿嘿！我不会。但是给你关注一下。帮你推一把

xyz2009xyz · 发表于 2010-7-19 13:23:00

希望有大虾解答

gufeng · 发表于 2010-7-19 17:28:00

注意看一下Mtext的组码 11

11	X 轴方向矢量（在 WCS 中） DXF：X 值；APP：三维矢量将作为 DXF 输入传递的组码 50（以弧度为单位的旋转角）转换为相等的方向矢量（如果同时传递代码 50 和代码 11、21、31，则对最后一个代码进行转换）。这是从文字对象转换的一种简便方法。

Text的组码 11

11	第二对齐点（在 OCS 中）（可选） DXF：X 值；APP：三维点只有当 72 或 73 组的值非零时，该值才有意义（如果对正不是基线对正/左对正）

程序中 make-text 函数始终传递inspt到10 与11 组码段当是Mtext的时候就与Text有变化

xyz2009xyz · 发表于 2010-7-19 20:48:00

那问下大虾有没有好的修改方法，入门不久，琢磨不出来！

xyz2009xyz · 发表于 2010-7-20 21:09:00

怎么没人来帮助啊？

gufeng · 发表于 2010-7-21 09:26:00

修改 make-text 函数就可以了

(defun make-text (first string inspt / remove txtlst lst)
(setq remove (list -1 330 5 1 10 11 50))
(setq txtlst (entget first))
(foreach n txtlst
(if (not (member (car n) remove))
(setq lst (cons n lst))
)
)
(if (= (cdr (assoc 0 lst)) "MTEXT")
(setq lst (subst (cons 41 (* (strlen string) 3)) (assoc 41 lst) lst))
);_重新计算多行文本的宽度
(setq lst (cons (cons 1 string) lst))
(setq lst (cons (cons 10 inspt) lst))
;;; (setq lst (cons (cons 11 inspt) lst))
(setq lst (reverse lst))
(cdr (assoc 40 (entmake lst)))
)

xyz2009xyz · 发表于 2010-7-21 17:36:00

谢谢帅哥，在线噢！

gufeng

终于可以用了，我也终于搞懂了，开始不了解组码，顺便传一个“查看取得图元对象的DXF组码数据值“小工具，此程序来自网络！答谢大家！见附件！

xyz2009xyz · 发表于 2010-7-29 08:45:00

麻烦大侠看看，这个程序问题，还是有问题加载后有时候正常，有时候又出现这种错误！见附件（运行时没有加载其他LISP）

;;;说明
;(alert "提醒:
; \n请首先设置好输精度<小数点位数>,在绘图的过程中可随时用命令JD设置精度。
; \n命令"+ - * /"分别代表对所选择的数字求和差积商。
; \n其中"- /" 则是以你第一个选到的数字文本为被减数和被除数。
; \n命令".."(点点)代表对所选择的数字文本统一加减乘除某个数，默认为1。
; \n命令"TJ"代表对所选择的数字文本进行数学统计。
; \n所有生成的新文本均与第一个选到的数字文本的样式相同(除角度外)。"
;)
;;;定义了一个全局变量为精度
(defun C:JD (/ )
;;(prompt "\n请输入精度,直接回车则为系统精度:")
(initget 4)
(if (setq PRECISION (getint))
(princ)
(setq PRECISION (getvar "LUPREC"))
)
)
;;(C:JD)
;;;加
(defun C:AW (/ key sel ins first numlst result)
(while (common1)
(setq result (apply '+ (cadr numlst)))
(common2)
)
(princ)
)
;;;减
(defun C:AD (/ key sel ins first numlst result)
(while (common1)
(setq result (apply '- (cadr numlst)))
(common2)
)
(princ)
)
;;;乘
(defun C:AE (/ key sel ins first numlst result)
(while (common1)
(setq result (apply '* (cadr numlst)))
(common2)
)
(princ)
)
;;;除
(defun C:AR (/ key sel ins first numlst result)
(while (common1)
(setq result (apply '/ (cadr numlst)))
(common2)
)
(princ)
)
;;;所有数字都加减乘除某个数
(defun C:AF (/ key op sel ins first numlst result)
(while (setq sel (ssget '((0 . "TEXT,MTEXT"))))
(setq first (ssname sel 0))
(setq Numlst (sel->list sel))
(initget 1 "+ - * /")
(setq key (getkword "\n请输入加减乘除符号<+ - * />:"))
(initget 2)
(if (null (setq op (getreal "\n请输入操作数<默认为1>:")))
(setq op 1.0)
)
(all-cal numlst key op)
)
(princ)
)
;;;
(defun all-cal (result sym op / lst old new)
(foreach n (car numlst)
(setq lst (entget n))
(setq old (atof (cdr (assoc 1 lst))))
(setq new (eval (cons (read sym) (list old op))))
(setq new (cons 1 (rtos new (getvar "LUNITS") PRECISION)))
(setq lst (subst new (assoc 1 lst) lst))
(entmod lst)
)
)
;;;选择和插入点
(defun common1 ()
(and
(setq sel (ssget '((0 . "TEXT,MTEXT"))))
(null (initget 0 "Yes No"))
(if (setq key (getkword "\n是否保留原数字Yes,No?<默认不保留>:"))
(setq key "Yes")
(setq key "No")
)
(setq first (ssname sel 0))
(setq Numlst (sel->list sel))
)
)
;;;做文字或者更新文字
(defun common2 ()
(setq result (rtos result (getvar "LUNITS") PRECISION))
(if (= key "No")
(if (setq ins (getpoint "\n请输入插入点:"))
(make-text first result ins)
)
(update-text first result)
)
)
;;;选择集合转化成数字列表
(defun sel->list (sel / i ent lst num Els nls)
(setq i 0)
(repeat (sslength sel)
(setq ent (ssname sel i))
(setq lst (entget ent))
(setq num (atof (cdr (assoc 1 lst))))
(setq Els (cons ent Els))
(setq Nls (cons num Nls))
(setq i (1+ i))
)
(list
(reverse Els)
(reverse Nls)
)
)
;;;创建新文字,在指定点插入(源程序)
;(defun make-text (first string inspt / remove txtlst lst)
; (setq remove (list -1 330 5 1 10 11 50))
; (setq txtlst (entget first))
; (foreach n txtlst
; (if (not (member (car n) remove))
; (setq lst (cons n lst))
; )
; )
; (setq lst (cons (cons 1 string) lst))
; (setq lst (cons (cons 10 inspt) lst))
; (setq lst (cons (cons 11 inspt) lst))
; (setq lst (reverse lst))
; (cdr (assoc 40 (entmake lst)))
;)
;注意看一下Mtext的组码 11
;11
;X 轴方向矢量（在 WCS 中）
;DXF：X 值；APP：三维矢量
;将作为 DXF 输入传递的组码 50（以弧度为单位的旋转角）转换为相等的方向矢量（如果同时传递代码 50 和代码 11、21、31，则;对最后一个代码进行转换）。这是从文字对象转换的一种简便方法。
;Text的组码 11
;11
;第二对齐点（在 OCS 中）（可选）
;DXF：X 值；APP：三维点
;只有当 72 或 73 组的值非零时，该值才有意义（如果对正不是基线对正/左对正）
;程序中 make-text 函数始终传递inspt到10 与11 组码段当是Mtext的时候就与Text有变化
(defun make-text (first string inspt / remove txtlst lst)
(setq remove (list -1 330 5 1 10 11 50))
(setq txtlst (entget first))
(foreach n txtlst
(if (not (member (car n) remove))
(setq lst (cons n lst))
)
)
(if (= (cdr (assoc 0 lst)) "MTEXT")
(setq lst (subst (cons 41 (* (strlen string) 3)) (assoc 41 lst) lst))
);_重新计算多行文本的宽度
(setq lst (cons (cons 1 string) lst))
(setq lst (cons (cons 10 inspt) lst))
; (setq lst (cons (cons 11 inspt) lst))
(setq lst (reverse lst))
(cdr (assoc 40 (entmake lst)))
)
;;;保留文字,仅更新内容
(defun update-text (ent string / txtlst)
(setq txtlst (entget ent))
(setq txtlst (subst (cons 1 string) (assoc 1 txtlst) txtlst))
(entmod txtlst)
)
;;;统计数字文本
(defun C:tj (/ un sel ins tollst numlst first data len ang HIG j n m)
(setq un (getvar "LUNITS"))
(while (and (setq sel (ssget '((0 . "TEXT,MTEXT"))))
(setq ins (getpoint "\n请输入插入点:")))
(princ "\n统计正在进行......")
(setq tollst (sel->list sel))
(setq numlst (cadr tollst))
(setq first (caar tollst))
(setq data (STAT numlst))
(setq len (strcat (caar data) (itoa (cdar data))))
(setq HIG (* (make-text first len ins) 1.5))
(setq ang (* Pi -0.5))
(setq j 1)
(repeat 4
(setq n (nth j data))
(setq m (strcat (car n) (rtos (cdr n) un PRECISION)))
(make-text first m (polar ins ang (* j HIG)))
(setq j (1+ j))
)
(princ "\n统计已经完成!")
)
(princ)
)
;;;统计函数
(defun STAT (numlst / len sum ave var sqr std)
(setq len (length numlst)) ;样本数目
(setq sum (apply '+ numlst)) ;和
(setq ave (/ sum len)) ;均值
(setq var (mapcar '(lambda (x) (* (- x ave) (- x ave))) numlst))
;差平方
(setq sqr (/ (apply '+ var) len)) ;方差 variance
(setq std (sqrt sqr)) ;标准差
(list
(cons "样本数......" len)
(cons "总和........" sum)
(cons "平均值......" ave)
(cons "方差........" sqr)
(cons "标准差......" std)
)
)

;;;说明
;(alert "提醒:
;      \n请首先设置好输精度<小数点位数>,在绘图的过程中可随时用命令JD设置精度。
;       \n命令"+ - * /"分别代表对所选择的数字求和差积商。
;       \n其中"- /" 则是以你第一个选到的数字文本为被减数和被除数。
;       \n命令".."(点点)代表对所选择的数字文本统一加减乘除某个数，默认为1。
;       \n命令"TJ"代表对所选择的数字文本进行数学统计。
;       \n所有生成的新文本均与第一个选到的数字文本的样式相同(除角度外)。"
;)
;;;定义了一个全局变量为精度
(defun C:JD (/ )
;;(prompt "\n请输入精度,直接回车则为系统精度:")
  (initget 4)
  (if (setq PRECISION (getint))
     (princ)
     (setq PRECISION (getvar "LUPREC"))
  ) 
)
;;(C:JD)  
;;;加
(defun C:AW (/ key sel ins first numlst result)
  (while (common1)
    (setq result (apply '+ (cadr numlst)))
    (common2)          
  )
  (princ)
)
;;;减
(defun C:AD (/ key sel ins first numlst result)
  (while (common1)
    (setq result (apply '- (cadr numlst)))
    (common2)          
  )
  (princ)
)
;;;乘
(defun C:AE (/ key sel ins first numlst result)
  (while (common1)
    (setq result (apply '* (cadr numlst)))
    (common2)          
  )
  (princ)
)
;;;除
(defun C:AR (/ key sel ins first numlst result)
  (while (common1) 
    (setq result (apply '/ (cadr numlst)))
    (common2)          
  )
  (princ)
)
;;;所有数字都加减乘除某个数
(defun C:AF (/ key op sel ins first numlst result)
  (while (setq sel (ssget '((0 . "TEXT,MTEXT")))) 
    (setq first  (ssname sel 0))
    (setq Numlst (sel->list sel))
    (initget 1 "+ - * /")
    (setq key (getkword "\n请输入加减乘除符号<+ - * />:"))
    (initget 2)
    (if (null (setq op (getreal "\n请输入操作数<默认为1>:")))
      (setq op 1.0)
    )        
    (all-cal numlst key op)          
  )
  (princ)
)
;;;
(defun all-cal (result sym op / lst old new)
  (foreach n (car numlst)
    (setq lst (entget n))
    (setq old (atof (cdr (assoc 1 lst))))
    (setq new (eval (cons (read sym) (list old op))))
    (setq new (cons 1 (rtos new (getvar "LUNITS") PRECISION)))
    (setq lst (subst new (assoc 1 lst) lst))
    (entmod lst)
  )
)
;;;选择和插入点
(defun common1 ()
  (and 
    (setq sel (ssget '((0 . "TEXT,MTEXT"))))
    (null (initget 0 "Yes No"))
    (if (setq key (getkword "\n是否保留原数字Yes,No?<默认不保留>:"))
      (setq key "Yes")
      (setq key "No")
    )  
    (setq first  (ssname sel 0))
    (setq Numlst (sel->list sel))
  )
)
;;;做文字或者更新文字
(defun common2 ()
  (setq        result (rtos result (getvar "LUNITS") PRECISION))  
  (if (= key "No")
    (if (setq ins (getpoint "\n请输入插入点:"))
      (make-text first result ins)
    )
    (update-text first result)
  )
)
;;;选择集合转化成数字列表
(defun sel->list (sel / i ent lst num Els nls)
  (setq i 0)
  (repeat (sslength sel)
    (setq ent (ssname sel i))
    (setq lst (entget ent))
    (setq num (atof (cdr (assoc 1 lst))))
    (setq Els (cons ent Els))
    (setq Nls (cons num Nls))
    (setq i (1+ i))
  )
  (list
    (reverse Els)
    (reverse Nls)
  )
)  
;;;创建新文字,在指定点插入(源程序)
;(defun make-text (first string inspt / remove txtlst lst)
;  (setq remove (list -1 330 5 1 10 11 50))
;  (setq txtlst (entget first))
;  (foreach n txtlst
;    (if (not (member (car n) remove))
;      (setq lst (cons n lst))
;    )
;  )  
;  (setq lst (cons (cons 1 string) lst))
;  (setq lst (cons (cons 10 inspt) lst))
;  (setq lst (cons (cons 11 inspt) lst))
;  (setq lst (reverse lst))
;  (cdr (assoc 40 (entmake lst)))
;)
;注意看一下Mtext的组码 11
;11 
;X 轴方向矢量（在 WCS 中）
;DXF：X 值；APP：三维矢量
;将作为 DXF 输入传递的组码 50（以弧度为单位的旋转角）转换为相等的方向矢量（如果同时传递代码 50 和代码 11、21、31，则;对最后一个代码进行转换）。这是从文字对象转换的一种简便方法。 
;Text的组码 11
;11 
;第二对齐点（在 OCS 中）（可选）
;DXF：X 值；APP：三维点
;只有当 72 或 73 组的值非零时，该值才有意义（如果对正不是基线对正/左对正）
;程序中 make-text 函数始终传递inspt到10 与11 组码段 当是Mtext的时候就与Text有变化

(defun make-text (first string inspt / remove txtlst lst)
  (setq remove (list -1 330 5 1 10 11 50))
  (setq txtlst (entget first))
  (foreach n txtlst
    (if (not (member (car n) remove))
      (setq lst (cons n lst))
    )
  )
  (if (= (cdr (assoc 0 lst)) "MTEXT")
    (setq lst (subst (cons 41 (* (strlen string) 3)) (assoc 41 lst) lst))
    );_重新计算多行文本的宽度
  (setq lst (cons (cons 1 string) lst))
  (setq lst (cons (cons 10 inspt) lst))
; (setq lst (cons (cons 11 inspt) lst))
  (setq lst (reverse lst))
  (cdr (assoc 40 (entmake lst)))
)
;;;保留文字,仅更新内容
(defun update-text (ent string / txtlst)
  (setq txtlst (entget ent))
  (setq txtlst (subst (cons 1 string) (assoc 1 txtlst) txtlst))
  (entmod txtlst)
)
;;;统计数字文本
(defun C:tj (/ un sel ins tollst numlst first data len ang HIG j n m)
  (setq un (getvar "LUNITS"))
  (while (and (setq sel (ssget '((0 . "TEXT,MTEXT"))))
              (setq ins (getpoint "\n请输入插入点:")))
    (princ "\n统计正在进行......")
    (setq tollst (sel->list sel))
    (setq numlst (cadr tollst))
    (setq first  (caar tollst))
    (setq data   (STAT numlst))
    (setq len (strcat (caar data) (itoa (cdar data))))
    (setq HIG (* (make-text first len ins) 1.5))
    (setq ang (* Pi -0.5))
    (setq j 1)
    (repeat 4
      (setq n (nth j data))
      (setq m (strcat (car n) (rtos (cdr n) un PRECISION)))
      (make-text first m (polar ins ang (* j HIG)))
      (setq j (1+ j))
    )
    (princ "\n统计已经完成!")
  )
  (princ)
)
;;;统计函数
(defun STAT (numlst / len sum ave var sqr std)
  (setq len (length numlst))                        ;样本数目
  (setq sum (apply '+ numlst))                      ;和
  (setq ave (/ sum len))                            ;均值
  (setq var (mapcar '(lambda (x) (* (- x ave) (- x ave))) numlst))
                                                    ;差平方
  (setq sqr (/ (apply '+ var) len))                 ;方差  variance 
  (setq std (sqrt sqr))                             ;标准差
  (list
    (cons "样本数......" len)
    (cons "总和........" sum)
    (cons "平均值......" ave)
    (cons "方差........" sqr)
    (cons "标准差......" std)
  )
)

账号		自动登录	找回密码
密码			注册

学习文本运算遇到的问题：多行文本运算缺陷

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源