Very Urgent Lisp

[107199]

Dear All,

This Lisp is used to sum text  and replace the result in text how make it insert the result as field

(defun c:sum()
(setq app "+")
(princ "\nSelect numbers to calculate:")
(setq cal(ssget '((0 . "TEXT"))))
(setq n 0)
(setq l(sslength cal))
(while(/= l n)
(get_info)
(if(= nu3 0.0)
(progn
(ssdel (ssname cal n) cal)
(setq l(- l 1))
(setq n(- n 1))
)
)
(setq n(+ n 1))
)
(setq n 0)
(setq l(sslength cal))
(cond
((= app "+")
(addc))
((= app "-")
(subc))
((= app "*")
(multc))
((= app "/")
(divdc))
)
(princ "\nAnswer= ")
(princ nu5)
(setq tx1 "Replace")
(cond
((= tx1 "Replace")
(setq tx2(ssget '((0 . "TEXT"))))
(setq n 0)
(setq l(sslength tx2))
(while(/= n l)
(setq tx3(entget(ssname tx2 n)))
(setq tx4(subst(cons 1 (rtos nu5 2 1))(assoc 1 tx3) tx3))
(entmod tx4)
(setq n(+ 1 n))
)
)
((= tx1 "Write")
(setq nu5(rtos nu5 2 1))
(command "layer" "m" "sr_text_n" "c" "3" "" "")
;(command "textstyle" "sr-romands2")
(princ "\nPick point for text insertion")
(command "text" "j" "m" pause "" "" nu5 )
)
)

(princ)

)



(defun get_info()
(setq nu1(entget (ssname cal n)))
(setq nu2(cdr(assoc 1 nu1)))
(setq nu3(atof nu2))
)

(defun addc()
(get_info)
(setq nu4 nu3)
(setq n(+ 1 n))
(while(/= l n)
(get_info)
(setq nu5(+ nu4 nu3))
(setq nu4 nu5)
(setq n(+ 1 n))
)
)

[ВeekeeCZ]

Since it's very urgent... here you go.

Franky, you deserve to be ignored for this kind of subject. 

(vl-load-com)

(defun c:TxtSum2Field  (/ asp adoc ss en pnt id fld obj opr)

  (setq opr "+")
  
  (setq asp (vla-get-modelspace (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))
  (vla-endundomark adoc) (vla-startundomark adoc)
  
  (if (and (setq ss (ssget '((0 . "TEXT") (410 . "Model"))))
	   (setq pnt (getpoint "\nSpecify point: "))
	   (setq fld "%<\\AcExpr ("))
    (progn
      (repeat (setq i (sslength ss))
	(setq en (ssname ss (setq i (1- i))))
	(if (and (numberp (read (cdr (assoc 1 (entget en)))))
		 (setq id (itoa (vla-get-objectid (vlax-ename->vla-object en))))
		 )
	  (setq fld (strcat fld "%<\\AcObjProp Object(%<\\_ObjId " id ">%).Textstring>%" opr))))
      (if (/= fld "%<\\AcExpr (")
	(progn
	  (setq fld (vl-string-right-trim opr fld)
		fld (strcat fld ") \\f \"%lu2%pr1\">%"))
	  (vla-put-AttachmentPoint
	    (setq obj (vla-addMText asp (setq pnt (vlax-3d-point pnt)) 0 fld))
	    acAttachmentPointMiddleCenter)
	  (vla-put-InsertionPoint obj pnt)))))
  (vla-endundomark adoc)
  (princ)
)

[john.uhden]

This is not a complete review.  I'll just mention a few of the things that stand out.

1.  Other than (setq app "+") I don't see where it is set to any other value such that you would need to use (cond ...).

2.  You have included code for "Write" but seem to be using only "Replace."

3.  I think you can include the textstyle within the text command.

4.  You have not localized any symbols, which I can understand while you are testing, but not for a finished product

5.  Your use of the symbol "l" (lowercase "L") confused me as it looks just like the numeral "1".

6.  You can compact your code a little, e.g. rather than (setq tx4 (subst ...))(entmod tx4) just (entmod (subst ...))

6.  You should consider turning off "cmdecho" and turning it back on.

7.  You should also add error and undo controls.

8.  You should either filter your text selection to ensure only numerics, or check the values post-selection prior to processing.

I recommend that you try to make these improvements and then respond with the latest for us to review.

[107199]

Thanks for your replay and sorry for the subject. after the operation i've tried to sum another text contain field with the result field it didn't read the field

[ВeekeeCZ]

Ok, now you can count texts with field created by this routine. That's all I can do. Hope this helps.

Original text must be number and only number. To texts with field created by this routine you can add any string. e.g Sum = <field>

(vl-load-com)

(defun c:TxtSum2Field  (/ asp adoc ss en pnt id fld obj opr pfl pfb pfe no)
  
  (setq opr "+"
        siz (getvar 'TEXTSIZE))
  
  (setq asp (vla-get-modelspace (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))
  (vla-endundomark adoc) (vla-startundomark adoc)
  
  (if (and (setq ss (ssget '((0 . "TEXT") (410 . "Model"))))
           (setq pnt (getpoint "\nSpecify point: "))
           (setq fld "%<\\AcExpr (")
           )
    (progn
      (repeat (setq i (sslength ss))
        (setq en (ssname ss (setq i (1- i))))
        (if (and (or (and (setq pfl (vla-fieldcode (vlax-ename->vla-object en)))
                          (setq pfb (vl-string-search "%<\\AcExpr (" pfl))
                          (setq pfe (vl-string-search ") \\f \"%lu2%pr1\">%" pfl))
                          )
                     (setq no (numberp (read (cdr (assoc 1 (entget en))))))
                     ) 
                 (setq id (itoa (vla-get-objectid (vlax-ename->vla-object en))))
                 )
          (setq fld (strcat fld
                            (if pfb
                              (substr pfl (+ pfb 12) (- pfe pfb 11))
                              (strcat "%<\\AcObjProp Object(%<\\_ObjId " id ">%).Textstring>%"))
                            opr))))
      (if (/= fld "%<\\AcExpr (")
        (progn
          (setq fld (vl-string-right-trim opr fld)
                fld (strcat fld ") \\f \"%lu2%pr1\">%"))
          (setq obj (vla-addText asp fld (setq pnt (vlax-3d-point pnt)) siz))
          (vla-put-Alignment obj acAlignmentMiddleCenter)
          (vla-put-TextAlignmentPoint obj pnt)))))
  (vla-endundomark adoc)
  (princ)
  )

[107199]

THANKS FOR YOUR REPLAY,BUT THERE IS ERROR IN THAT ROUTIN

[ВeekeeCZ]

I'm not receiving any. So since you're not giving me any details, only I can do is to be sorry about it.

[107199]

after selecting the inserting point :

Erreur : bad argument type: numberp: nilbad argument type: VLA-OBJECT nil

[ВeekeeCZ]

Sorry, the reason is not obvious to me and I'm not receiving the error.

Maybe some else would know.

[john.uhden]

No help from here.  You know more than I do.  :[

[Ranjit_Singh]

Post drawing with data that gives error. That's the only way to figure out the error. The routine isn't showing any error at my end. So it's something with your data. 

[107199]

hi,

What I am doing here is to sum the last two branches and sum the total with the next branches with (L/S Suffix )…etc

[Ranjit_Singh]

You never mentioned the L/S suffix before. It is very simple to add that suffix to a final evaluated value. But if the text/mtext strings that you wish to add already have a L/S suffix then I don't think you can do a add operation on those. You can do it with LISP but it will not be dynamic as a field. Unless you specifically implement a reactor on top of the LISP. But then it gets really complicated.

Get rid of the L/S suffix in your text/mtext and use @ВeekeeCZ's routine.

[ВeekeeCZ]

Next time, please - I can help only if you fully describe your issue. Just words are usually not enough. You should ALWAYS attach a DWG example with both states before and after. It not just helps us better understand your issue but also allows us to test our code.

And please READ my instructions - You can select LINE, POLYLINES and *TEXTs with ITS own fields!!! You can't make some field using autocad's field command - this routine will not work with them.

Try the code.

(vl-load-com)

(defun c:Len2Field  (/ asp adoc ss ent pnt oid otp fld obj opr pfl pfb pfe)
  
  (setq opr "+"
        siz (getvar 'TEXTSIZE))
  
  (setq asp (vla-get-modelspace (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))
  (vla-endundomark adoc) (vla-startundomark adoc)
  
  (if (and (princ "\nReguired LINEs, POLYLINEs or TEXT with regular numbers or TEXT with fields made by this routine, ")
           (setq ss (ssget '((0 . "*TEXT,LINE,LWPOLYLINE") (410 . "Model"))))
           (setq *suf* (cond (*suf*)
                             ((getstring T "\nSuffix: "))))
           (setq pnt (getpoint "\nSpecify point: "))
           (setq fld "%<\\AcExpr (")
           )
    (progn
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i)))
              obj (vlax-ename->vla-object ent)
              otp (cdr (assoc 0 (entget ent)))
              oid (itoa (vla-get-objectid obj))
              fld (strcat fld (cond ((and (wcmatch otp "*TEXT" )
                                          (setq pfl (vla-fieldcode obj))
                                          (setq pfb (vl-string-search "%<\\AcExpr (" pfl))
                                          (setq pfe (vl-string-search ") \\f \"%lu2%pr0\">%" pfl)))
                                     (strcat (substr pfl (+ pfb 12) (- pfe pfb 11)) opr))

                                    ((and (wcmatch otp "*TEXT" )
                                          (not (zerop (atoi (cdr (assoc 1 (entget en)))))))
                                     (strcat "%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Textstring>%" opr))

                                    ((wcmatch otp "*LINE")
                                     (strcat "%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Length>%" opr))

                                    ("")))))
      (if (/= fld "%<\\AcExpr (")
        (progn
          (setq fld (vl-string-right-trim opr fld)
                fld (strcat fld ") \\f \"%lu2%pr0\">%" *suf*))
          (setq obj (vla-addText asp fld (setq pnt (vlax-3d-point pnt)) siz))
          (vla-put-Alignment obj acAlignmentMiddleCenter)
          (vla-put-TextAlignmentPoint obj pnt)))))
  (vla-endundomark adoc)
  (princ "\nTo SUFFIX reset type following in the command line: (setq *suf* nil)")
  (princ)
)

[107199]

Dear all,

Thanks for all help provided by all people specially @BeekeeCZ and i'm sorry for not clarify the issue in detail and let me fix that. The case here is that I have a main pipe which have some branches which was drawn in a not to scale schematic diagram(the flow rate isn’t the length of pipe line it’s just a branch symbol) , these branches is to be summed and put the result in the sum text (XXX L/S)

And to make this task I should sum these flow rates and type the summation in the text and so on this diagram always have thousands  of  summation so I was thinking to make lisp to just select the first text( e.g. 0.057L/S ) and the second text (e.g. 0.063L/S) and select the summation text (XXX L/S ) to provide the result as a field with the suffix (L/S) . the point here is that sometimes we need to add an equipment in the end of the pipe braches in this case I should re-sum all these flow rates but in field case it will be updated automatically.

[ВeekeeCZ · Accepted solution]

Good, now we have something to work with!

The only limitation for you that I can't solve is that initial numbers must be WITHOUT suffix. You need to separate the suffix - as I did, see attached DWG.

Then the routine's result will include the suffix of your own assignment within the routine.

See the SCREENCAST how to use it... 

Hope this helps, good luck.

(vl-load-com)

(defun c:Len2Field  (/ asp adoc ss ent pnt oid otp fld obj opr pfl pfb pfe)
  
  (setq opr "+"
        siz (getvar 'TEXTSIZE))
  
  (setq asp (vla-get-modelspace (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))
  (vla-endundomark adoc) (vla-startundomark adoc)
  
  (if (and (princ "\nReguired LINEs, POLYLINEs or TEXT with regular numbers or TEXT with fields made by this routine, ")
           (setq ss (ssget '((0 . "*TEXT") (410 . "Model"))))
           (setq *suf* (cond (*suf*)
                             ((getstring T "\nSuffix: "))))
           (setq pnt (getpoint "\nSpecify point: "))
           (setq fld "%<\\AcExpr (")
           )
    (progn
      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i)))
              obj (vlax-ename->vla-object ent)
              otp (cdr (assoc 0 (entget ent)))
              oid (itoa (vla-get-objectid obj))
              fld (strcat fld (cond ((and (setq pfl (vla-fieldcode obj))
                                          (setq pfb (vl-string-search "%<\\AcExpr (" pfl))
                                          (setq pfe (vl-string-search ") \\f \"%lu2%pr3\">%" pfl)))
                                     (strcat (substr pfl (+ pfb 12) (- pfe pfb 11)) opr))

                                    ((not (zerop (atof (cdr (assoc 1 (entget ent))))))
                                     (strcat "%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Textstring>%" opr))

                                    ("")))))
      (if (/= fld "%<\\AcExpr (")
        (progn
          (setq fld (vl-string-right-trim opr fld)
                fld (strcat fld ") \\f \"%lu2%pr3\">%" *suf*))
          (setq obj (vla-addText asp fld (setq pnt (vlax-3d-point pnt)) siz))
	  ))))
  (vla-endundomark adoc)
  (princ "\nTo SUFFIX reset type following in the command line: (setq *suf* nil)")
  (princ)
)

[107199]

What a brilliant solution. but i was asking is that possible to replace the ( XXX L/S) with the summation filed in state of insert it just for making sure of justification of all similar summations. another addition to make this lisp perfect is there away to add the pipe by adding routine  to insert a text with distance (350 mm up direction)  with ( "pipe size" mm) pipe size will be according to the summation flow text according to the attached table as up to 0.3 L/S the size will be 20 mm and from 0.3 to 0.57 L/S the size will  be 25 mm and so on  (e.g. for example if flow 0.05 L/S the pipe size 20 mm )

 

[ВeekeeCZ · Accepted solution]

Ok, try the following code. Fill up the range table, see the code how and where. 

You need to select the texts manually - it works for both TEXT and TEXT with a field. I tried to add a filter to exclude unit texts, unfortunately the filter (1 . "#*") does not work with fields. 

I like @_Tharwat's core sub routine from the other thread, so I used that. 

(vl-load-com)

(defun c:PipeSize ( / :pipesize ss i ed)

  ; by Tharwat
  (defun :pipesize (lps / ps)
    (vl-some
      '(lambda (v) (and (<= lps (car v)) (setq ps (cadr v))))
      '(
        (0.3 20)
        (0.57 25)
        (1.21 32) ; FILL UP THE RANGE ACCORDING YOUR TABLE
        
        ))
    (cond (ps
           (strcat (itoa ps) " mm"))
          ("N/A")))

  (if (setq ss (ssget '((0 . "TEXT"))))
    (repeat (setq i (sslength ss))
      (entmake (append (setq ed (entget (ssname ss (setq i (1- i)))))
                       (list (cons 1 (:pipesize (atof (cdr (assoc 1 ed)))))
                             (cons 10 (polar (cdr (assoc 10 ed)) (/ pi 2) 380))
                             (cons 11 (polar (cdr (assoc 10 ed)) (/ pi 2) 380)))
                       ))))
  (princ)
)

[107199]

Wonderful that*s a great one Many Thanks.