adincer Posted January 20, 2017 Share Posted January 20, 2017 Hi I have a problem. If you can help I'll be glad to you. I have some chainage labels as 1+234.56 format. I want a lisp for increase-decrease selected chainage values by specified amount. Thank You Quote Link to comment Share on other sites More sharing options...
gS7 Posted January 20, 2017 Share Posted January 20, 2017 welcome to Cadtutor adincer Please attached a sample drawing for more clarification , we will help you Quote Link to comment Share on other sites More sharing options...
adincer Posted January 20, 2017 Author Share Posted January 20, 2017 For example I have an alignment like below. Due to change at the beginning part, alignment has shorten 200 meters. A lisp for this job? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 20, 2017 Share Posted January 20, 2017 See here....... Quote Link to comment Share on other sites More sharing options...
adincer Posted January 21, 2017 Author Share Posted January 21, 2017 Thank you so much Lee Mac. But given code for 1+23.45 format, not for 1+234.56 I think your code for imperial units. I modified for it like that: ;; 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) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.