链测长度更改Lisp
你好我有个问题。如果你能帮忙，我会很高兴的。
我有一些链测长度标签为1+234.56格式。
我想要一个lisp，用于按指定数量增减选定链测长度值。
非常感谢。 欢迎来到CADCER，请附上一张样品图，以便进一步澄清，我们将帮助您 例如，我有如下对齐方式。
由于开始部分的更改，路线缩短了200米。
这份工作的Lisp程序？
请看这里。。。。。。。 非常感谢李。
但给定的代码是1+23.45格式，而不是1+234.56格式
我认为你的代码是英制单位。
我对此进行了如下修改：
;; 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 'multilineactrue)
(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)
页:
[1]