To round the value in this lisp

To round the value in this lisp

Anonymous
Non applicable
1 319 Visites
11 Réponses
Message 1 sur 12

To round the value in this lisp

Anonymous
Non applicable

Hello, I am trying to get this to work so that the value in green is rounded to the nearest multiple of 5.

I have very little knowledge of lisp. Is this easily possible without another function?

 

(vl-load-com)
(defun c:GG (/ atent attobj ent leng obj)
(while
(setq ent
(entsel "\nSelect Polyline (or press eEnter to Exit): "))
(setq obj (vlax-ename->vla-object (car ent)))
(setq leng (rtos
(vlax-get-property obj "Length")
2
0 ; <--precison 0 decimals
)
)
(if
(setq atent
(nentsel "\nSelect Attribute: "))
(progn
(setq attobj (vlax-ename->vla-object (car atent)))
(vlax-put-property attobj "TextString" leng)
)
)
)
(princ)

0 J'aime
Solutions acceptées (2)
1 320 Visites
11 Réponses
Replies (11)
Message 2 sur 12

CodeDing
Advisor
Advisor

@Anonymous ,

 

This is the best function I can come up with to round to nearest 5:

(defun Round5 (num / )
  (setq num (fix num))
  ((if (minusp num) - +)
    (+ (* 5 (/ (abs num) 5))
       (if (> (rem (abs num) 5) 2) 5 0)
    )
  )
)

Best,

~DD

Message 3 sur 12

Anonymous
Non applicable

Thank you DD! Although I am not sure where in the lisp I posted I should place that bit so that the outcome is rounded. The lisp gets the length of a selected pline and places the value into an attribute of a block.

0 J'aime
Message 4 sur 12

CodeDing
Advisor
Advisor
Solution acceptée

@Anonymous ,

 

This should do:

(vl-load-com)
(defun c:GG ( / Round5 atent attobj ent leng obj)
  (defun Round5 (num / )
    (setq num (fix num))
    ((if (minusp num) - +)
      (+ (* 5 (/ (abs num) 5))
         (if (> (rem (abs num) 5) 2) 5 0)
      )
    )
  )
  (while
    (setq ent
      (entsel "\nSelect Polyline (or press eEnter to Exit): "))
    (setq obj (vlax-ename->vla-object (car ent)))
    (setq leng (rtos
      (Round5 (vlax-get-property obj "Length"))
      2
      0 ; <--precison 0 decimals
    ))
  )
  (if
    (setq atent
      (nentsel "\nSelect Attribute: "))
    (progn
      (setq attobj (vlax-ename->vla-object (car atent)))
      (vlax-put-property attobj "TextString" leng)
    )
  )
)
(princ)

Best,

~DD

0 J'aime
Message 5 sur 12

Anonymous
Non applicable

DD,

 

    Thank you for you continued assistance. I am trying to assist another drafter in the office speed up the work flow in his department. I spend a good part of the day yesterday analyzing his problem and I believe I have come up with a more proper lisp solution than the one I posted originally. I then spent the evening learning the basics of list processing. Hopefully I will be here helping others some day but it may be a while.. There is so much to learn!

 

    I am not sure if I should create another post or even if this is too much to ask here. So, please feel free to let me know if it is but I'll lay it out. You don't know if you don't try, right?

 

    So, here is the work I would like to create a lisp to preform; 

Drafter must draw PLINE from equip to its termination.

Drafter finds PLINE distance, rounds that value to nearest multiple of 5

Drafter put rounded value into attribute of block1 (SOC SVC FOOTAGE)

Drafter adds 15 to rounded value and put sum into attribute of either block2 (svcdir_right-2006) or block3 (svcdir_left-2006)

    This must be done for hundreds of lots on every job of this type.

 

    My solution would be one routine that does all of this by Frankensteining a few lisps I have found together.

I found this code (Post on cadtutor) written by Lee Mac and modified by sadhu: 

(defun c:cdt (/ *error* Round DLST PT PTLST TOT)
 ;; Lee Mac  ~  01.03.10


(SETQ CLY (GETVAR "CLAYER"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OTM (GETVAR "ORTHOMODE"))
(setvar "orthomode" 0)
(setvar "osmode" 0)


[color=red](defun LWPoly (lst)
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 0))
                   (mapcar (function (lambda (p) (cons 10 p))) lst))))[/color]


 (defun Round (num dp / fac rm)
   (setq fac (float (expt 10 dp))
         rm  (rem (setq num (* fac num)) 1)) 
   
   (/ (cond (  (zerop rm) (fix num))
            
            (  (< 0.5 rm) (1+ (fix num)))
            
            (  (+ (/ 5 fac) (fix num)))) fac))
 
 (if (car (setq ptLst (list (setq pt3 (getpoint "\nSpecify First Point: ")))))
   (progn
         (while (setq pt (getpoint "\nSpecify Next Point: " (car ptLst)))
       
       (mapcar
         (function
           (lambda (from to)
             (grdraw from to 3 1)))

         (reverse (setq ptLst (cons pt ptLst)))

         (cdr (reverse ptLst)));mapcar

       (setq dLst (cons (Round (distance (car ptlst) (cadr ptlst)) 1) dLst))

       (princ (strcat "\n<< Distance: " (rtos (car dLst)) " -- "
                      "Cumulative: " (setq tot (rtos (apply (function +) dLst) 2 2)) " >>"))


   
   ) ;while

   [b][color=red] (LWPoly ptlst)  [/color][/b]  
     
     (if (setq pt (getpoint "\nSpecify Point for Text: "))
       (entmakex (list (cons 0 "MTEXT")
                       (cons 100 "AcDbEntity")
                       (cons 100 "AcDbMText")
                       (cons 8 "RH_FDP")
                       (cons 10 pt)
                       (cons 1 tot)
                       (cons 40 0.1)
         )
       )
     );if

     );progn
   );if
 (princ (strcat "\nDistanza  : " tot "  **"))

 (redraw)
(SETVAR "CLAYER" CLY)
(SETVAR "OSMODE" OSM)
(SETVAR "ORTHOMODE" OTM)
 
 (princ))

This prompts the user to draw a PLINE using entmakex, does a bit of rounding to the value of the PLINE's length and then places that value into a TEXT the user selects the insertion point of.  Almost perfectly does most of the job but I think a few tweaks/additions to it would do the trick.

 

    The other bit I would like to incorporate into this is the lips I had originally posted (To save space I won't repost it)

So that the rounded value can be placed into a block attribute. Only, LM's code rounds to the nearest .05 and I need it to 5. Also instead of putting the rounded value into a TEXT entity I would like to insert block1 with that value as it's attribute. Then add 15 to that rounded value and insert another block with the choice of either block2 or block3 with that sum as is attribute's value. The cherry on top would be for the lisp to repeat.

 

    This may be a bit of a tall order. So, I will understand if it would take too much time to put together. Any assistance is greatly appreciated.

 

-Matthew

 

0 J'aime
Message 6 sur 12

Sea-Haven
Mentor
Mentor
Solution acceptée

Try this does not have error check for pick wrong object. It should be straight forward make pline round up to 5, then pick the blocks "ATRIBUTTES" block1 block2 can be any block.

 

 

(defun c:cdt (/ Round5 x cly osm otm ah:plll lwpoly obj len endpt ptlst)
 ;; Lee Mac  ~  01.03.10


(SETQ CLY (GETVAR "CLAYER"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OTM (GETVAR "ORTHOMODE"))
(setvar "orthomode" 0)
(setvar "osmode" 0)

(defun ah:plll ()
  (prompt "pick points Enter to finish ")
    (command "pline" 
      (while (= (getvar "cmdactive") 1 ) (command pause))
    )
)

(defun LWPoly (lst)
  (entmakex (append (list 
	(cons 0 "LWPOLYLINE")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbPolyline")
	(cons 90 (length lst))
	(cons 70 0))
	(mapcar (function (lambda (p) (cons 10 p))) lst))
  )
)


(defun Round5 (num X / )
    (setq num (fix num))
    ((if (minusp num) - +)
      (+ (* x (/ (abs num) x))
         (if (> (rem (abs num) x) 2) x 0)
      )
    )
)
 
(ah:plll)
  
(setq obj (vlax-ename->vla-object (entlast)))

(setq len  (Round5 (vlax-get obj 'Length) 5))
(setq endpt (vlax-curve-getpointatdist obj len))

(setq ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(setq ptlst (subst endpt (last ptlst) ptlst))
 
(command "erase" (entlast) "")
 
(LWPoly ptlst)
	  
(Alert  (strcat "\n<< Distance: " (rtos len 2 0)  " >>"))
     
(setq att (vlax-ename->vla-object (car (nentsel "\nPick attribute in Block1 "))))
  (vla-put-textstring att (rtos len 2 0))

(setq att (vlax-ename->vla-object (car (nentsel "\nPick attribute in Block2 "))))
  (vla-put-textstring att (rtos (+ len 15.0)  2 0))
   
(command "regen")

(SETVAR "CLAYER" CLY)
(SETVAR "OSMODE" OSM)
(SETVAR "ORTHOMODE" OTM)
 
(princ)
)
(c:cdt)

 

Ps if you see any of these [COLOR=RED] [b] etc or others that look like that, remove them will screw up code they are older forum control codes.

 

  

0 J'aime
Message 7 sur 12

ronjonp
Advisor
Advisor
FWIW you should pay @leemac to give you a solid solution.
0 J'aime
Message 8 sur 12

Anonymous
Non applicable
Thanks for the tip. I am going to reach out to him on the swamp now that I have something to run with. He's a legend. You guys all are.
0 J'aime
Message 9 sur 12

Anonymous
Non applicable

That works like a charm. Thank you and also for the tip on the old forum control codes. I took the alert out and didn't manage to break it. Small steps.  

0 J'aime
Message 10 sur 12

Sea-Haven
Mentor
Mentor

No worries when tasks are straight forward is easy to help.

 

Lee-mac.com is his website.

0 J'aime
Message 11 sur 12

TomBeauford
Advisor
Advisor

Rounding functions listed on Lee Mac's website: http://www.lee-mac.com/round.html

64bit AutoCAD Map & Civil 3D 2023
Architecture Engineering & Construction Collection
2023
Windows 10 Dell i7-12850HX 2.1 Ghz 12GB NVIDIA RTX A3000 12GB Graphics Adapter
Message 12 sur 12

Anonymous
Non applicable
Thank you
0 J'aime