Jump to content

searching for subtracting lisp


ayman

Recommended Posts

  • Replies 20
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    7

  • ayman

    6

  • alanjt

    3

  • Shaheensha976

    3

Try this:

 

(defun c:subtxt (/ ParseNumbers GR NUM1 NUM2 P RES)
 (vl-load-com)
 ;; Lee Mac  ~  09.04.10

 (defun ParseNumbers (str / lst Num Aph x rtn)
   ;; Lee Mac  ~  20.09.09
   (setq lst (vl-string->list str) Num "" Aph "")
   
   (while (setq x (car lst))
     (setq lst (cdr lst))
     
     (cond (  (and (/= "" Num) (= 46 x))
              (setq Num (strcat Num (chr x))))
           
           (  (< 47 x 58)
              (setq Num (strcat Num (chr x))
                    rtn (cons Aph rtn) Aph ""))
           
           (t (setq Aph (strcat Aph (chr x))
                    rtn (cons (read Num) rtn) Num ""))))
   
   (vl-remove nil
     (vl-remove ""
       (reverse (cons Aph (cons (read Num) rtn))))))


 (mapcar
   (function
     (lambda (sym str / ent)
       (while
         (progn
           (setq ent (car (nentsel str)))

           (cond (  (eq 'ENAME (type ent))

                    (if (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT")

                      (if (not
                            (set sym
                              (car
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (vl-position
                                        (type x) '(INT REAL))))

                                  (ParseNumbers
                                    (cdr
                                      (assoc 1 (entget ent))))))))

                        (princ "\n** Text Must Contain a Number **"))

                      (princ "\n** Object Must be Text **")))

                 (  (princ "\n** Nothing Selected **")))))))
   
   '(num1 num2) '("\nSelect Text to Subtract from: " "\nSelect Text to Subtract: "))

 (if (and num1 num2
          (setq res (entmakex (list (cons 0 "TEXT")
                                    (cons 10  (getvar 'VIEWCTR))
                                    (cons 40  (getvar 'TEXTSIZE))
                                    (cons 7   (getvar 'TEXTSTYLE))
                                    (cons 1   (rtos (- num1 num2))))))
          (setq res (entget res)))

   (while (and (= 5 (car (setq gr (grread 't 13 0))))
                 (listp (setq p (cadr gr))))

       (entupd
         (cdr
           (assoc -1
             (setq res
               (entmod
                 (subst (cons 10 p) (assoc 10 res) res))))))))
 (princ))
     

Link to comment
Share on other sites

lee mac thank you very much you are so kind that was wat i want but i want the result rotated at 90 degree and precision 2 like this 3.52 and make it multiple because i have too much number thanks again

Link to comment
Share on other sites

Try this:

 

(defun c:subtxt (/ ParseNumbers GR NUM1 NUM2 P RES)
 (vl-load-com)
 ;; Lee Mac  ~  09.04.10

 (defun ParseNumbers (str / lst Num Aph x rtn)
   ;; Lee Mac  ~  20.09.09
   (setq lst (vl-string->list str) Num "" Aph "")
   
   (while (setq x (car lst))
     (setq lst (cdr lst))
     
     (cond (  (and (/= "" Num) (= 46 x))
              (setq Num (strcat Num (chr x))))
           
           (  (< 47 x 58)
              (setq Num (strcat Num (chr x))
                    rtn (cons Aph rtn) Aph ""))
           
           (t (setq Aph (strcat Aph (chr x))
                    rtn (cons (read Num) rtn) Num ""))))
   
   (vl-remove nil
     (vl-remove ""
       (reverse (cons Aph (cons (read Num) rtn))))))


 (mapcar
   (function
     (lambda (sym str / ent)
       (while
         (progn
           (setq ent (car (nentsel str)))

           (cond (  (eq 'ENAME (type ent))

                    (if (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT")

                      (if (not
                            (set sym
                              (car
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (vl-position
                                        (type x) '(INT REAL))))

                                  (ParseNumbers
                                    (cdr
                                      (assoc 1 (entget ent))))))))

                        (princ "\n** Text Must Contain a Number **"))

                      (princ "\n** Object Must be Text **")))

                 (  (princ "\n** Nothing Selected **")))))))
   
   '(num1 num2) '("\nSelect Text to Subtract from: " "\nSelect Text to Subtract: "))

 (if (and num1 num2
          (setq res (entmakex (list (cons 0 "TEXT")
                                    (cons 10  (getvar 'VIEWCTR))
                                    (cons 40  (getvar 'TEXTSIZE))
                                    (cons 7   (getvar 'TEXTSTYLE))
                                    (cons 50  (/ pi 2))
                                    (cons 1   (rtos (- num1 num2) (getvar 'LUNITS) 2)))))
          (setq res (entget res)))

   (while (and (= 5 (car (setq gr (grread 't 13 0))))
                 (listp (setq p (cadr gr))))

       (entupd
         (cdr
           (assoc -1
             (setq res
               (entmod
                 (subst (cons 10 p) (assoc 10 res) res))))))))
 (princ))

Link to comment
Share on other sites

lee mac ther's small thing

i want when i call the lisp and when he ask me for selecting text to subtract from i want to select many number not just one

ant when i hit enter it ask me to select Text to Subtract ant when i hit enter it give me the result and this image will exlanin what i want

1_11.jpg

 

thank's lee for help

Link to comment
Share on other sites

Nice one Alan :thumbsup:

Thanks :)

I'll probably never use it (I haven't used the old one I have in a year or so), but it was fun to write.

Link to comment
Share on other sites

lee mac firest of all thank's for help the secend is i have too much to click pair because i have too much pairs so if u do what i want it will be better and thank's for help man

Link to comment
Share on other sites

lee mac firest of all thank's for help the secend is i have too much to click pair because i have too much pairs so if u do what i want it will be better and thank's for help man

Consider how much work you would have without what was provided to you, for free.

Link to comment
Share on other sites

  • 6 months later...
  • 9 years later...
On 4/9/2010 at 3:25 PM, Lee Mac said:

(defun c:subtxt (/ ParseNumbers GR NUM1 NUM2 P RES) (vl-load-com) ;; Lee Mac ~ 09.04.10 (defun ParseNumbers (str / lst Num Aph x rtn) ;; Lee Mac ~ 20.09.09 (setq lst (vl-string->list str) Num "" Aph "") (while (setq x (car lst)) (setq lst (cdr lst)) (cond ( (and (/= "" Num) (= 46 x)) (setq Num (strcat Num (chr x)))) ( (< 47 x 58) (setq Num (strcat Num (chr x)) rtn (cons Aph rtn) Aph "")) (t (setq Aph (strcat Aph (chr x)) rtn (cons (read Num) rtn) Num "")))) (vl-remove nil (vl-remove "" (reverse (cons Aph (cons (read Num) rtn)))))) (mapcar (function (lambda (sym str / ent) (while (progn (setq ent (car (nentsel str))) (cond ( (eq 'ENAME (type ent)) (if (wcmatch (cdr (assoc 0 (entget ent))) "*TEXT") (if (not (set sym (car (vl-remove-if-not (function (lambda (x) (vl-position (type x) '(INT REAL)))) (ParseNumbers (cdr (assoc 1 (entget ent)))))))) (princ "\n** Text Must Contain a Number **")) (princ "\n** Object Must be Text **"))) ( (princ "\n** Nothing Selected **"))))))) '(num1 num2) '("\nSelect Text to Subtract from: " "\nSelect Text to Subtract: ")) (if (and num1 num2 (setq res (entmakex (list (cons 0 "TEXT") (cons 10 (getvar 'VIEWCTR)) (cons 40 (getvar 'TEXTSIZE)) (cons 7 (getvar 'TEXTSTYLE)) (cons 50 (/ pi 2)) (cons 1 (rtos (- num1 num2) (getvar 'LUNITS) 2))))) (setq res (entget res))) (while (and (= 5 (car (setq gr (grread 't 13 0)))) (listp (setq p (cadr gr)))) (entupd (cdr (assoc -1 (setq res (entmod (subst (cons 10 p) (assoc 10 res) res)))))))) (princ))

 

Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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...