[编程交流] 链测长度更改Lisp

;; Change Station  -  Lee Mac
;; Allows the user to add or subtract numerical values from a stationing label
;; e.g. 186+489.85 Bridgeline P/L - 152267.70 = 34+220.15 Bridgeline P/L
(defun c:lmstat ( / *error* dec dim enx inc num pos rgx sel str val )
   (defun *error* ( msg )
       (if (= 'int (type dim))
           (setvar 'dimzin dim)
       )
       (if (and (= 'vla-object (type rgx)) (not (vlax-object-released-p rgx)))
           (vlax-release-object rgx)
       )
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (if
       (and
           (setq sel (ssget "_:L" '((0 . "TEXT") (1 . "*#+###*"))))
           (setq num (getreal "\nSpecify amount to add or subtract: "))
       )
       (if (setq rgx (vlax-get-or-create-object "vbscript.regexp"))
           (progn
               (setq dim (getvar 'dimzin))
               (setvar 'dimzin 0)
               (vlax-put-property rgx 'global     actrue)
               (vlax-put-property rgx 'ignorecase actrue)
               (vlax-put-property rgx 'multiline  actrue)
               (vlax-put-property rgx 'pattern "\\d+\\+\\d+\\.*\\d+")
               (repeat (setq inc (sslength sel))
                   (setq enx (entget (ssname sel (setq inc (1- inc))))
                         str (cdr (assoc 1 enx))
                   )
                   (vlax-for itm (vlax-invoke rgx 'execute str)
                       (setq itm (vlax-get itm 'value)
                             pos (vl-string-position 43 itm)
                             val (+ (atof (strcat (substr itm 1 pos) (substr itm (+ pos 2)))) num)
                             str (vl-string-subst
                                     (strcat (itoa (fix (/ val 1000.0)))
                                         (if (minusp val) "-" "+")
                                         (if (< (setq dec (abs (rem val 1000.0))) 100.0)
                                             (strcat "0" (rtos dec 2 2))
                                             (rtos dec 2 2)
                                         )
                                     )
                                     itm str
                                 )
                       )
                   )
                   (entmod (subst (cons 1 str) (assoc 1 enx) enx))
               )
               (setvar 'dimzin dim)
               (vlax-release-object rgx)
           )
           (princ "\nUnable to interface with RegExp object.")
       )
   )
   (princ)
)
(vl-load-com) (princ)