[已解決]求~~文字數字加總計算的lsp?

代碼:

(defun c:sumtxt()
  (setvar "cmdecho" 0) ;關閉LISP在指令區的操綽回應
  (setq oldlay (getvar "clayer")) ;取出舊圖層設定值
  (setq oldos (getvar "osmode")) ;取出舊物件鎖點設定值
  (setvar "osmode" 0) ;關閉物件鎖點*避免物件鎖點干擾
  (setq gum 1)
  (prompt "\n框選統計數值:")
  (setq ds (ssget '((0 . "*text"))))
  (setq n (sslength ds)
 i 0
 j       0
 numlist '()
 sum     0
  )
  (repeat n
    (setq en (ssname ds i))
    (setq endata (entget en))
    (setq num (cdr(assoc gum endata)))
    (setq numlist (cons num numlist))
    (setq i (1+ i))
  )
  (repeat (length numlist)
    (setq num1 (atof (nth j numlist)))
    (setq sum (+ num1 sum))
    (setq j (1+ j))
    )
  (princ "\n選取數值總合為:")
  (princ sum)
  (alert (strcat "選取數值總合=" (rtos sum 2 2)))
  (setvar "cmdecho" 1)
  (setvar "clayer" oldlay)
  (setvar "osmode" oldos)
  (princ)
  )

代碼:

<CommandMethod("Count")> Public Sub CreateCount()
        Dim optSel As New PromptSelectionOptions()
        optSel.MessageForAdding = "選取要計算的物件"
        Dim resSel As PromptSelectionResult = ed.GetSelection(optSel)
        If resSel.Status = PromptStatus.OK Then
            Dim sSet As SelectionSet = resSel.Value
            Dim ids As ObjectId() = sSet.GetObjectIds()
            Dim Count As Integer = 0
            Using trans As Transaction = db.TransactionManager.StartTransaction()
                For Each sSetEntId As ObjectId In ids
                    Dim ent As Entity = trans.GetObject(sSetEntId, OpenMode.ForRead)
                    Dim Name As String = ent.GetType().Name
                    If Name = "DBText" Then
                        Dim Type As DBText = trans.GetObject(sSetEntId, OpenMode.ForRead)
                        Dim Vaule As Double = Val(Type.TextString)
                        Count = Count + Vaule
                    End If
                Next
                trans.Commit()
            End Using
            ed.WriteMessage(vbCrLf & "數值總和為:" & Count)
        End If
    End Sub

ginse0727 寫到:這個程式不算難啦,應該很多人都會寫,所以用不著跪求啦!!
有空閒所以就幫你個小忙囉.

NaNa 寫到:您好，我也正在為數字加總的問題煩惱
但我不懂lsp如何在CAD上運用
可以告訴我嗎?感激不盡

tarpon 寫到:

NaNa 寫到:您好，我也正在為數字加總的問題煩惱
但我不懂lsp如何在CAD上運用
可以告訴我嗎?感激不盡

工具>>載入應用程式>>選擇您要載入的程式所在資料夾及程式>>載入
執行時在命令列輸入應用程式設定的命令即可以上例即sumtxt
也可在命令列輸入(load "sumtxt") 載入[但sumtxt.lsp程式要放在支援檔案路徑資料夾內]

代碼:


;文字數值計算加總
(defun c:tea(/ i num sum);/ en ds i endata num sum #dd)
  (prompt "\n框選統計數值:")
  (setq ds (ssget '((0 . "*text"))))
  (setq #dd(getint "\n小數位數<0>:"))
  (if (null #dd) (setq #dd 0))
  (setq   i 0 sum 0 numlist '())
  (repeat (sslength ds)
    (setq en (ssname ds i))
    (setq endata (entget en))
    (setq num (cdr(assoc 1 endata)))
    (setq sum (+ (atof num) sum))
    (setq i (1+ i))
    )
  (returntea sum #dd)
  (prin1)
  )

;回填計算值至文字中
(defun returntea(#sum #dd)
  (setq newval(cons 1 (rtos #sum 2 #dd)))
  (setq en (entsel "\n選取總合貼附:"))   ;;;選取欲貼上計算值的text
  (if (null en)
    (alert (strcat "選取數值總合=" (rtos #sum 2 #dd)))
    (progn
      (setq endata (entget (car en)))
      (setq oldval (assoc 1 endata))
      (setq endata (subst newval oldval endata))
      (entmod endata)
      )
    )
  )


代碼:

(DEFUN C:+(/ wd da db no0 no1 non ns naa nab)
  (setq wd (getstring "\nNo.>>: "))
  (setq da nil db nil no0 1 naa nil non (strlen wd) ns 1 no1 0)
  (if (= d1 nil) (setq d1 0))
  (while  (< no0 (+ non 2))
      (setq naa (substr wd no0 1))
      (if (or (= "+" naa) (= "-" naa) (= "*" naa) (= "/" naa)(= """" naa))
          (progn
          (if da
              (progn
                  (setq db (atof (substr wd ns no1)))
                  (cond ((= "+" nab)
                        (setq d1 (+ da db))
                        )
                        ((= "-" nab)
                        (setq d1 (- da db))
                        )
                        ((= "*" nab)
                        (setq d1 (* da db))
                        )
                        ((= "/" nab)
                        (setq d1 (/ da db))
                        )
                  ) (setq da d1)
              );progn yes da
              (if (= no0 1) (setq da d1) (setq da (atof (substr wd ns no1))))
          );if da
          (setq no1 -1 ns (+ no0 1) nab naa)
          );progn
      );if
      (setq no1 (+ no1 1) no0 (+ no0 1))
  );while
  (Grtext 22 (RTOS D1 2 6))
  (COMMAND "OFFSET" (ABS D1) "");順便把OFFSET值也改了
  (prompt "\    = ") (eval d1)
)

tooth525 寫到:請問若有符號與數量時該怎麼改呢
[img][/img]

tooth525 寫到:請問若有符號與數量時該怎麼改呢
[img][/img]

代碼:

(DEFUN C:++()
(setq s1 (ssget) sslen (sslength s1) I (1- sslen) d1 0 d2 0)
(while (>= I 0)
 (setq s2 (ssname s1 I)
      ent (cdr (assoc 1 (entget s2)))     
 ) 
 (progn 
  (setq wd ent)
  (if (= "$" (substr wd 1 1))
      (setq wd (substr wd 2))
  ) 
  (prompt "  取得: ")(princ wd)
  (c+++)
  (prompt "=")(princ d1)
  (setq d2 (+ d1 d2))
  (setq I (1- I))
 );p
);w
  (prompt "  合計= ")(princ d2)
  (setq inspt (getpoint "\nESC結束或寫入點: "))
  (command "text" inspt "0" (strcat "$" (rtos d2 2 0)))
  (prin1)
)
(DEFUN C+++(/ da db no0 no1 non ns naa nab)
  (setq da nil db nil no0 1 naa nil non (strlen wd) ns 1 no1 0)
  (setq d1 (atof wd));add
    (while  (< no0 (+ non 2))
      (setq naa (substr wd no0 1))
      (if (or (= "+" naa) (= "-" naa) (= "*" naa) (= "X" naa) (= "x" naa) (= "/" naa)(= """" naa))
          (progn
          (if da
              (progn
                  (setq db (atof (substr wd ns no1)))      
        (cond ((= "+" nab)
                        (setq d1 (+ da db))
                        )
                        ((= "-" nab)
                        (setq d1 (- da db))
                        )
         ((= "X" nab)
                        (setq d1 (* da db))
                        )
                        ((= "x" nab)
                        (setq d1 (* da db))
                        )
         ((= "*" nab)
                        (setq d1 (* da db))
                        )
                        ((= "/" nab)
                        (setq d1 (/ da db))
                        )
                  )
        (setq da d1)
              );progn yes da
              (if (= no0 1) (setq da d1) (setq da (atof (substr wd ns no1))))
          );if da
          (setq no1 -1 ns (+ no0 1) nab naa)
          );progn
      );if
      (setq no1 (+ no1 1) no0 (+ no0 1))
  );while 
)