对话框数字文字公式修改工具（第二版）

newer

请在 XDRX API BUILD 2016.12.13 和 通用函数库 2016.12.18以上版本运行。

[sell]

(defun c:XDTB_TEXT_NUMSFORMULA (/ txtl c:TextFormulaSS_OnClicked c:TextReplaceOk_OnClicked
                                c:TextFormulaClear_OnClicked c:Cancel_OnClicked
                                c:MakeFormula_OnClicked $xdob_textNumsFormula_display
                                c:TextNumsFormula_OnInitialize formula FormulaBox i introw jd n Nums
                                oldvallist op Operator ss TextFormulaJD TextFormulaOk TextFormulaSS
                                TextNumsFormula TextNumsFormulaGrid txtl txtl1 txtl2 val vallist x
                                xd_odcl_textnumsformula
                               )
  (defun XD::String:EscapeCha (str / key1 key2 n str1)
    (setq str1 ".,<><()[]{}#?-!+*"
          str1 (xdrx_string_regexps "." str1)
    )
    (foreach n str1
      (setq str (xdrx_string_replace str n (strcat "\\" n)))
    )
  )
  (setq xd_odcl_textnumsformula
         '("YWt6A0RVAAAgJyLHBuKTJQMSarlrAZmxe+Wmm93bX3RujWu+njHOdXR/LDYc8n9ZDFvJDxO5SKq4"
           "OGapUNA6mlQwFFrVy1TW4vRBIrfTLuXaL+3Igv/uVd9uK9b0qtbUVOSs6NoXD1Vkx+vlBISgxaOl"
           "4wmZo0UNmUXwJRUQickRCRigwvEHERjj0Rhq5lsFYaq+zQ561J9+knhhfoJEZR5f4PfC2HIknwcW"
           "/GjWuqx0+y5yG65y8wYreKXedpFoPHvqPEecPALMYi9vEjkkVaAX+mwCwa+h4txk5e7Mc5fbgip7"
           "wC3wmTjNuDQ6OwYr97HqHhP7hiJ7qKr2k+qd4wyCFZzMagzXyUeqLSZw+HGsvkLO57IDrntZn0YI"
           "qQZlaCVqjW+ddhr+nU6wTpkCAvajSmilhnUGG4KyuIKC5XzBW44xe4C6EPF2uDXuE5+Zd2kW40kw"
           "yqqrwfrbnQ4gvRozG/UPM92ZQ/3dr3nZnl6KXvWjHk+lfWNGLLh4xYtzqoWBP+irRsCDHk0CcKIV"
           "Vj7blvrDBqv3zBC/BbiJykS+htS+be6XHm7yoXUE0fhhcMlxMR9H+LFivUVjhgVkoU/MAgSjgWsT"
           "i3cSlrGZrCZoTKBci1iVfkiqulLp/+9VVLRqc8FYlkFohiv/AZpPFmN/S4+dCP/xeXqV5VxLk2yK"
           "0XYCKMoJRb7VYbGmsc0kMPSJgWAuLUEgXaCB+aNh2PnOykpO0iU/KOhvHqEx0c+XUW6wrDrNzm78"
           "gfKp+1uBOiakPP9Fy0QN1d9oKB9HtFyRvpVZjslz8jUIIRB18e4xixJsAyEYrSFaAra4oVkCprih"
           "XoJJ02Ee0suXEW2D3vPBO8Y0Bup9fCl1gsq+qToFlbvGRgK4VFLH2kblZ0BYE7rOcglxZBJhp/f5"
           "osn0yPR6CJa7yq512DXD9j6YMoHq7qsiC948qlULnOKW+fXwgm0KY9dewie20i6e89yDIXSSrk9k"
           "Ah3L7odo5YDhTQ+uvzSvISNZaSqdci72NDsPeLN6U9AkJDomRBpReYK+QkWeWK+gtXypd6Jczgqe"
           "0XaCuwcIjtMEBceKiFi48TRRzx5RZSpNyuUA3Fqch78DQLbW1SGpIQvOhDayAsLKGfmDgG4KhZuA"
           "R5KRD/b9A/8xkZFEnwE8pOVT2GwpBR3wiv4WZzsPv8smr127FQrZex0iHS8M+UBCIRAakksh6Nii"
           "KOKjKFQg90YgR3rEwYVTOkkgHwEEEbtV+KGNk7gWm2o0nNoZyrzNm91ywxm1nM7iE48DlxIdbDlC"
           "jjJCnHbwrWMIy7TZpbuFDpG7b7vgDzpQq4lOvWs/VU6Frupkn0YoKGIFs4uuWvmYEv4es+fWQ68M"
           "hxKZ50cV8D0tpr043mcyIVVKu993A259M/Yeax9HIJvQuPXrcok2R9mTQvSMg+yOYkd8gW8MU+Jw"
           "hB+irBe0D2aR5XW9aBM426lIKmGnB/a6iOOZSIqurFQj1ajYmGlxgdyghscWh1FQy6EK3wN2NRmT"
           "j3nOGiik4SNGg+0w3VudVFKxbDOEhPh68WvBl29VcHfiYZmmr709AloCnSE7EmY/0oYjvJ0vJMEC"
           "PcKZjkrRbSB8dXyL1t5nlHkN4c/mgHlvRyPLl0rkuOZmS+ln8Bku+SEFrGl7wdiFz1uQRW+Fj4Rm"
           "+ysgoPASjT/45dvJtc8NvmCCQ/tzCvjPXJyucKwkT4Hag5iShwDJkvzPslCYTklTeYlWGHmWRA9l"
           "CuMGbaIbIpetGzItOPKZ0DvoPgonqZzh5eIH4yhxskGVorV00NNfKv7gpDYMITNfNSS/RkI1VPM+"
           "VktW+uou3EFtxIXU8rDArwR0yGy/IQNzCgGLZJaA1HOQawE7tJKY0eB6reRgHGbgS3uTAlFYFQwA"
           "cO7M4YfI4cqJFCFAYPeTsktxi8xjIA8OprDpP8ljoOk1UqW3rMAajyTb3cYG63f9KZfErorkjknO"
           "NKloxcuE8b2vHOchN9MwjoK334tL+nPvZ2qlCjQF3d+ftV76+AFA7hyFpQsWQgN4n6qGMXYBRM6+"
           "vmsfpcAzgiW2wWWHCdWV5InRdul1xMB48AtEKb+XtLPIQHijyAa6HBUlVr5twoSjtu05ZtWeiogU"
           "+BAhIXvTAdmY6YeFhJROerFBmYWpx5jksjxiwMgcxL1EV20JJOfps4JlCuUX+lamMlqV2h6QYEG8"
           "rhWJxkbLBQKBkmCN8mbXs7O9kA+2Z6q7OPH8EN0pdjkPieYpMJEciUZYjdiFkA/4y6iWmGUWsffN"
           "yXz4nxsRP02ZGYJFufPi2ZeXHVTx9Rc6BW78ma/rQ4cz9+6543mjWMFzxDNjfQnlx33Es8o8sh2z"
           "4q40khc/6q/TH5bjr+u6St11NeEtZ+P7HeuvA37EkJF4Q921ismTVZzznVwyKoZUvQG7qeeoS91S"
           "ZWsHAemT4I0PBbv34ImzzGCHSjS5s2BVv7J+qUwKtX41LGceHBv+6cFAgCJcGP6pPsmYeK4TEEGi"
           "XWeeRPggZx43VH3CAUy+bDaycu7BnPZefXLH+GQ/eLaLxbLVRZ+QTL7bQKN5Qn9PsX5plE3Zocaj"
           "grprTs2/i3K9tXi1m1KErpJFnep5yJ6HGlRR+ua4uyVeBgizkkIDRG+MvAH/ENeb3iWkXA7J2ru8"
           "7Ig/sh2vAlELiLJurbJ1ifZKllXt6jOyITokeL9IPWGPWBw6BMkFbE/n81zyNodghg23CgaU/nFr"
           "XH2BjI/xQAogY4aSBzGLSI1DRO1nQxDw/3E5TU5e3/CvlRSwW3fwWxGjKkeRM1UGCTS/C83CDfk1"
           "YOisCZHWhKEz14BlLZS80xcLBwwkI4IWRNeGoQq9mkG6Zr6rRVRltVBi+f/lLRRyuR56sbe6AZNT"
           "SjjXfahmIttMt/u43nS59HTDaZHAOZ1eQDhZGSpEj0H1Y65mRoeQ0STvasKtP4LCT0vdyKF2v0Fo"
           "WaFp+MWrpj49rI+BcIwxRO6Trn/zke8gS0Cm2FCKqdWvkOTanYGoijIecgrAhauGLkW0wicjltMt"
           "mcTUqjaloNqdoZynVFqR9daVnT1WDaqJr6AkmgPBZBCl2/hkNO30AUR4lMjUz78Y6Etjnb0j8lMD"
           "YReh1fjlCdY/AtDB2F5XhwGLIsHERqyzgqVM0RzniaiTrrQOvYjanYGshvaNAXarx4iDUg3cb7Gp"
           "USNy6gaJSaT57ZHvyGOkRjIwMNT39/d+kdplj5ARynHsz5oFzhBDpQeF0EKrIyW0wiFkZTREoJde"
           "gDmvqNeuP5n/5OvUBSnwFFAzKYvbR7aFDiyMMHm3oFToc3KoaE6BfYulqzYpIyyMwNmET430sITU"
           "/wFfnPsnoLo/dK4YQ4W8RSHvmQoPSOnF0JrnGYEBzb2Bf6tTeSQ="
          )
  )
  (defun c:MF-Check1#OnClicked (Value /)
    (if (= value 1)
      (dcl-Control-SetEnabled MF-After t)
      (dcl-Control-SetEnabled MF-After nil)
    )
  )
  (defun c:MF-Check2#OnClicked (Value /)
    (if (= value 1)
      (dcl-Control-SetEnabled MF-Before t)
      (dcl-Control-SetEnabled MF-Before nil)
    )
  )
  (defun c:TextFormulaSS_OnClicked (/ formula jd x)
    (setq tf t
          str_after ""
          str_before ""
    )
    (if (= 1 (dcl-Control-GetValue MF-Check1))
      (progn
        (if (= "" (dcl-Control-GetText MF-After))
          (progn (dcl-MessageBox "字符之后不能为空.") (setq tf nil))
          (setq str_after (dcl-Control-GetText MF-After))
        )
      )
    )
    (if (= 1 (dcl-Control-GetValue MF-Check2))
      (progn
        (if (= "" (dcl-Control-GetText MF-BEFORE))
          (progn (dcl-MessageBox "字符之前不能为空.") (setq tf nil))
          (setq str_before (dcl-Control-GetText MF-BEFORE))
        )
      )
    )
    (if tf
      (progn (setq formula (dcl_Control_GetText FormulaBox))
             (if (/= "" formula)
               (progn (setq jd (dcl_ComboBox_GetEBText TextFormulaJD))
                      (cond ((= (strlen jd) 1) (setq jd 0))
                            (t (setq jd (- (strlen jd) 2)))
                      )
                      (setq match "[0-9.]+")
                      (if (/= str_after "")
                        (setq match (strcat "(?<=" (XD::STRING:ESCAPECHA str_after) ")[0-9.]+"))
                      )
                      (if (/= str_before "")
                        (setq match (strcat match "(?=" (XD::STRING:ESCAPECHA str_before) ")"))
                      )
                      (setq txtl2
                             (mapcar '(lambda (x)
                                        (if (setq old (xdrx_string_regexps match (car x)))
                                          (progn (if (= jd 0)
                                                   (progn (setq val
                                                                 (fix
                                                                   (+ 0.5
                                                                      (xdrx_string_evalExpression (strcat (car old) formula))
                                                                   )
                                                                 )
                                                          )
                                                   )
                                                   (progn (setq val (xdrx_string_format1
                                                                      (float
                                                                        (xdrx_string_evalExpression (strcat (car old) formula))
                                                                      )
                                                                      jd
                                                                    )
                                                                val (atof val)
                                                          )
                                                   )
                                                 )
                                          )
                                        )
                                        (setq val (XD::String:Strpad
                                                    val
                                                    (if (setq a (xdrx_string_regexps "[0-9]+(?=\\.)" (car old)))
                                                      (strlen (car a))
                                                      (strlen (car old))
                                                    )
                                                    "0"
                                                    jd
                                                  )
                                        )
                                        (setq val (xdrx_string_regexpr match (car x) val))
                                        (list (car x) formula val)
                                      )
                                     txtl1
                             )
                      )
                      ($xdob_textNumsFormula_display txtl2)
                      (dcl_Control_SetEnabled TextFormulaOk t)
               )
             )
      )
    )
  )
  (defun c:TextFormulaOk_OnClicked (/ i n)
    (dcl_form_close TextNumsFormula)
    (setq i 0)
    (mapcar '(lambda (x)
               (xdrx_setpropertyvalue
                 (car x)
                 "textstring"
                 (last (nth i txtl2))
               )
               (setq i (1+ i))
             )
            txtl
    )
    (princ)
  )
  (defun c:TextFormulaClear_OnClicked (/)
    (dcl_Control_SetText FormulaBox "")
    (dcl_Control_SetEnabled TextFormulaOk nil)
    (dcl_Control_SetEnabled TextFormulaSS nil)
    ($xdob_textNumsFormula_display txtl1)
    (princ)
  )
  (defun c:Cancel_OnClicked (/)
    (dcl_Form_close TextNumsFormula)
    (princ)
  )
  (defun c:MakeFormula_OnClicked (/ oldvallist op val vallist)
    (setq op  (dcl_ComboBox_GetEBText Operator)
          val (dcl_Control_GetText Nums)
    )
    (if (/= "" val)
      (progn (setq oldvallist (dcl_Control_GetText FormulaBox))
             (dcl_Control_SetText
               FormulaBox
               (setq vallist (strcat oldvallist (strcat op val)))
             )
             (dcl_Control_SetEnabled TextFormulaSS t)
      )
    )
    (princ)
  )
  (defun $xdob_textNumsFormula_display (val / introw n)
    (dcl_Grid_Clear TextNumsFormulaGrid)
    (foreach n val
      (if (setq intRow (dcl_Grid_AddString TextNumsFormulaGrid (car n)))
        (progn (dcl_Grid_SetCellText
                 TextNumsFormulaGrid
                 intRow
                 1
                 (nth 1 n)
               )
               (dcl_Grid_SetCellText
                 TextNumsFormulaGrid
                 intRow
                 2
                 (nth 2 n)
               )
               (dcl_Grid_SetCellText
                 TextNumsFormulaGrid
                 intRow
                 3
                 (nth 3 n)
               )
               (dcl_Grid_SetCellText
                 TextNumsFormulaGrid
                 intRow
                 4
                 (nth 4 n)
               )
        )
      )
    )
    (princ)
  )
  (defun c:TextNumsFormula#OnInitialize (/)
    ($xdob_textNumsFormula_display txtl1)
    (princ)
  )
  (xdrx_sysvar_push "osmode" "cmdecho")
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (prompt "\n选取要修改的数字文字<退出>:")
  (if (not (setq ss (ssget '((0 . "TEXT")))))
    (exit)
  )
  (mapcar '(lambda (x)
             (setq txtl (cons (list x (xdrx_getpropertyvalue x "textstring")) txtl))
           )
          (xdrx_pickset->ents ss)
  )
  (setq txtl (reverse txtl))
  (setq txtl1 (mapcar '(lambda (x) (list (cadr x) "" "")) txtl))
  (if (> (length txtl1) 0)
    (progn (if (XD::Doc:AutoLoadOpenDCL)
             (progn (dcl-project-import xd_odcl_textnumsformula)
                    (dcl_Form_Show TextNumsFormula)
             )
           )
    )
    (prompt "\n没有发现数字文字。")
  )
  (xdrx_end)
  (xdrx_sysvar_pop)
  (princ)
)

[/sell]

zhouzhiy

谢谢楼主分享！

zhouzhiy

谢谢楼主分享！

renyonghua2014

需要学习一下，3Q

newer

2018.12.13日更新

人工

谢谢楼主分享！

7079977a

谢谢楼主分享

7079977a

出现错误：参数类型错误：stringp nil

香远益清

看着还可以，试试能否测试成功。

香远益清

错误: 参数类型错误: stringp nil

jian2903

试试会不会报错

yaojing38

非常好用，谢谢奉献

hh_lj007

感谢分享，学习