文字选择问题

流_星

大神谁能吧下面的程序改成文字能选择单行多行和属性文字，数字最后能计算，谢谢大神了。
(DEFUN C:jf()
(setq jd 4)(princ "\精度为4")
(if (= jd nil) (setq jd 4))
(princ "\nselect object:")
(setq s (ssget))
(setq n (sslength s))
(setq k 0 )(setq mm 0.0)
(while (< k n)
      (setq name (ssname s k))
      (setq a (entget name))
      (setq t1 (assoc '0 a))
      (setq t1 (cdr t1))
      (if (= t1 "TEXT") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (setq tx (atof tx))
          (setq mm (+ tx mm))
         ))
      (if (= t1 "DIMENSION") (PROGN
          (setq tx (assoc '1 a))
          (setq tx (cdr tx))
          (if (and (/= tx "")(/= tx "<>"))(setq tx (atof tx)))
          (if (or (= tx "")(= tx "<>"))(progn
              (setq tx (assoc '42 a))
              (setq tx (cdr tx))
              ))
          (if (= k 0) (setq MM TX) (setq mm (+ tx mm)))
         ))
      (setq k (+ k 1))
)
(setq mm (rtos mm 2 jd))
  (princ "\n总和: ")(princ mm)

;;;;;;;;;;;;;;;;;;;;;;

xyp1964

1. (defun c:tt ()
   
2.   (defun dxf (code s1) (cdr (assoc code (entget s1))))
   
3.   (princ "\n选择: ")
   
4.   (setq ss (ssget '((0 . "*text,DIMENSION"))))
   
5.   (setq i -1)
   
6.   (setq mm 0.0)
   
7.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
8.     (setq t1 (DXF 0 s1))
   
9.     (cond ((member t1 '("TEXT" "MTEXT"))
   
10.            (setq mm (+ (atof (DXF 1 s1)) mm))
    
11.           )
    
12.           ((= t1 "DIMENSION")
    
13.            (setq tx (DXF 1 s1))
    
14.            (if (and (/= tx "") (/= tx "<>"))
    
15.              (setq tx (atof tx))
    
16.            )
    
17.            (if (or (= tx "") (= tx "<>"))
    
18.              (setq tx (DXF 42 s1))
    
19.            )
    
20.            (setq mm (+ tx mm))
    
21.           )
    
22.     )
    
23.   )
    
24.   (princ "\n总和: ")
    
25.   (princ (rtos mm 2 3))
    
26.   (princ)
    
27. )

(defun c:tt ()<br />   (defun dxf (code s1) (cdr (assoc code (entget s1))))<br />   (princ "\n选择: ")<br />   (setq ss (ssget '((0 . "*text,DIMENSION"))))<br />   (setq i -1)<br />   (setq mm 0.0)<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq t1 (DXF 0 s1))<br />     (cond ((member t1 '("TEXT" "MTEXT"))<br />            (setq mm (+ (atof (DXF 1 s1)) mm))<br />           )<br />           ((= t1 "DIMENSION")<br />            (setq tx (DXF 1 s1))<br />            (if (and (/= tx "") (/= tx "<>"))<br />              (setq tx (atof tx))<br />            )<br />            (if (or (= tx "") (= tx "<>"))<br />              (setq tx (DXF 42 s1))<br />            )<br />            (setq mm (+ tx mm))<br />           )<br />     )<br />   )<br />   (princ "\n总和: ")<br />   (princ (rtos mm 2 3))<br />   (princ)<br /> )

流_星

xyp1964 发表于 2019-1-5 15:02

您好我刚才测试了一下，块中的属性文字还是不能选择，有办法解决吗

流_星

有人帮忙解决吗

wudechao

(defun c:tt ()
  (defun dxf (code s1)
    (cdr (assoc code (entget s1)))
  )
  (princ "\n选择: ")
  (setq ss (ssget '((0 . "ATTRIB,*text,DIMENSION"))))
  (setq i -1)
  (setq mm 0.0)
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (setq t1 (dxf 0 s1))
    (cond
      ((member t1 '("TEXT" "MTEXT"))
        (setq mm (+ (atof (dxf 1 s1)) mm))
      )
      ((member t1 '("ATTRIB"))
        (setq mm (+ (atof (dxf 2 s1)) mm))
      )
      ((= t1 "DIMENSION")
        (setq tx (dxf 1 s1))
        (if (and
              (/= tx "")
              (/= tx "<>")
            )
          (setq tx (atof tx))
        )
        (if (or
              (= tx "")
              (= tx "<>")
            )
          (setq tx (dxf 42 s1))
        )
        (setq mm (+ tx mm))
      )
    )
  )
  (princ "\n总和: ")
  (princ (rtos mm 2 3))
  (princ)
)

流_星

wudechao 发表于 2019-1-5 21:55
(defun c:tt ()
  (defun dxf (code s1)
    (cdr (assoc code (entget s1)))

您好，我刚才测试了快中的属性文字还是不让选择，应该还是优点问题

xyp1964

1. ;; tt(数字求和)
   
2. (defun c:tt ()
   
3.   (defun get-Attibutes (s1 / lst x)
   
4.     (mapcar '(lambda (x) (setq lst (cons (vla-Get-TextString x) lst)))
   
5.             (vlax-safearray->list
   
6.               (vlax-variant-value
   
7.                 (vla-GetAttributes (vlax-ename->vla-object s1))
   
8.               )
   
9.             )
   
10.     )
    
11.     lst
    
12.   )
    
13.   (defun dxf (code s1) (cdr (assoc code (entget s1))))
    
14.   (princ "\n选择: ")
    
15.   (setq ss (ssget '((0 . "*TEXT,DIMENSION,ATTRIB,ATTDEF,INSERT"))))
    
16.   (setq i -1)
    
17.   (setq mm 0.0)
    
18.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
19.     (setq et (DXF 0 s1))
    
20.     (cond ((member et '("TEXT" "MTEXT"))
    
21.            (setq mm (+ (atof (DXF 1 s1)) mm))
    
22.           )
    
23.           ((and        (member et '("ATTRIB" "ATTRIB"))
    
24.                 (setq tx (distof (DXF 2 s1)))
    
25.            )
    
26.            (setq mm (+ tx mm))
    
27.           )
    
28.           ((= et "DIMENSION")
    
29.            (setq tx (DXF 1 s1))
    
30.            (if (and (/= tx "") (/= tx "<>"))
    
31.              (setq tx (atof tx))
    
32.            )
    
33.            (if (or (= tx "") (= tx "<>"))
    
34.              (setq tx (DXF 42 s1))
    
35.            )
    
36.            (setq mm (+ tx mm))
    
37.           )
    
38.           ((and (= et "INSERT") (= (DXF 66 s1) 1))
    
39.            (setq lst (get-Attibutes s1)
    
40.                  lst (vl-remove-if-not '(lambda (x) (distof x)) lst)
    
41.                  tx  (apply '+ (mapcar 'distof lst))
    
42.            )
    
43.            (setq mm (+ tx mm))
    
44.           )
    
45.     )
    
46.   )
    
47.   (princ "\n总和: ")
    
48.   (princ (rtos mm 2 3))
    
49.   (princ)
    
50. )

;; tt(数字求和)<br /> (defun c:tt ()<br />   (defun get-Attibutes (s1 / lst x)<br />     (mapcar '(lambda (x) (setq lst (cons (vla-Get-TextString x) lst)))<br />             (vlax-safearray->list<br />               (vlax-variant-value<br />                 (vla-GetAttributes (vlax-ename->vla-object s1))<br />               )<br />             )<br />     )<br />     lst<br />   )<br />   (defun dxf (code s1) (cdr (assoc code (entget s1))))<br />   (princ "\n选择: ")<br />   (setq ss (ssget '((0 . "*TEXT,DIMENSION,ATTRIB,ATTDEF,INSERT"))))<br />   (setq i -1)<br />   (setq mm 0.0)<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq et (DXF 0 s1))<br />     (cond ((member et '("TEXT" "MTEXT"))<br />            (setq mm (+ (atof (DXF 1 s1)) mm))<br />           )<br />           ((and        (member et '("ATTRIB" "ATTRIB"))<br />                 (setq tx (distof (DXF 2 s1)))<br />            )<br />            (setq mm (+ tx mm))<br />           )<br />           ((= et "DIMENSION")<br />            (setq tx (DXF 1 s1))<br />            (if (and (/= tx "") (/= tx "<>"))<br />              (setq tx (atof tx))<br />            )<br />            (if (or (= tx "") (= tx "<>"))<br />              (setq tx (DXF 42 s1))<br />            )<br />            (setq mm (+ tx mm))<br />           )<br />           ((and (= et "INSERT") (= (DXF 66 s1) 1))<br />            (setq lst (get-Attibutes s1)<br />                  lst (vl-remove-if-not '(lambda (x) (distof x)) lst)<br />                  tx  (apply '+ (mapcar 'distof lst))<br />            )<br />            (setq mm (+ tx mm))<br />           )<br />     )<br />   )<br />   (princ "\n总和: ")<br />   (princ (rtos mm 2 3))<br />   (princ)<br /> )

流_星

xyp1964 发表于 2019-1-5 23:54

高手您好:程序试了，现在能选择块了，是把块内的所以数字求和。
其实我想的事，同一个块中的任意几个属性数据求和，或是，几个块的属性任意求和，能吗？
谢谢

xyp1964

流_星 发表于 2019-1-6 09:15
高手您好:程序试了，现在能选择块了，是把块内的所以数字求和。
其实我想的事，同一个块中的任意几个属 ...

典型的瞎折腾！

流_星

主要是工作需要，我在找找相关的资料吧谢谢