Jump to content
adincer

Chainage Change Lisp

Recommended Posts

adincer

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

Share this post


Link to post
Share on other sites
gS7

welcome to Cadtutor adincer Please attached a sample drawing for more clarification , we will help you :)

Share this post


Link to post
Share on other sites
adincer

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?

 

large?v=1.0&px=705

Share this post


Link to post
Share on other sites
adincer

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)

Share this post


Link to post
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...