流_星 发表于 2019-1-5 14:37:42

文字选择问题

大神谁能吧下面的程序改成文字能选择单行多行和属性文字，数字最后能计算，谢谢大神了。
(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 发表于 2019-1-5 15:02:07

(defun c:tt ()
(defun dxf (code s1) (cdr (assoc code (entget s1))))
(princ "\n选择: ")
(setq ss (ssget '((0 . "*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))
          )
          ((= 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)
)

流_星 发表于 2019-1-5 15:43:34

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


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

流_星 发表于 2019-1-5 20:45:03

有人帮忙解决吗

wudechao 发表于 2019-1-5 21:55:29

(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)
)

流_星 发表于 2019-1-5 22:26:13

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


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

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

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

流_星 发表于 2019-1-6 09:15:31

本帖最后由 流_星 于 2019-1-6 12:13 编辑

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

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

xyp1964 发表于 2019-1-6 16:26:51

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

典型的瞎折腾！

流_星 发表于 2019-1-6 17:47:47

主要是工作需要，我在找找相关的资料吧谢谢
页: [1]
查看完整版本: 文字选择问题