Topic: Length Lisp

[jbaxter]

Greetings,

I am in need of a short lisp routine to assist
me in entering pipe lengths on a scaled plan acad2004.

First want to select the pline, which is comprised of
 straight linear segments.

Need the routine to determine the length of the polyline selected,
 multiply that length by 200 then divide the result by 1000 (rounded up),
 then place text (not mtext) at the point selected
 with an "m" suffix denoting metres e.g. 25m, does not matter what angle but 2.5 text height preferred.

Kind Regards,
John

[ronjonp]

Try this one...it places the text for you:

Code: [Select]


;Puts text with objects length in it------Many thanks to the SWAMP.ORG for all the help
(defun c:rlt (/ *error* u-clayer getboundingbox llc urc s1 index ent obj bbox mpt obj_length txt deltext)
  (command ".undo" "begin")  
(vl-load-com)

;_____________________________
;Error function
;_____________________________

(defun *error* (msg)
   (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; if
(setvar 'clayer u-clayer)
    (princ)
  ) ;end error function

;_____________________________
;Get User Variables
;_____________________________

(setq u-clayer (getvar 'clayer))
(if (tblsearch "layer" "length")
  (command "-layer" "thaw" "length" "on" "length" "")
  (princ "\n Layer 'length' Created")
)
(command ".-layer" "m" "length" "")
 
  (defun getboundingbox (obj / minpt maxpt)
    (vla-getboundingbox obj 'minpt 'maxpt)
    (mapcar 'vlax-safearray->list (list minpt maxpt))
    (setq llc (vlax-safearray->list minpt)
          urc (vlax-safearray->list maxpt)
    )
    (list llc urc)
  )
  (if (setq sl (ssget '((0 . "LWPOLYLINE,POLYLINE,LINE"))

               )
      )
    (progn
      (setq index -1)
      (while (< (setq index (1+ index)) (sslength sl))
        (setq ent (ssname sl index))
        (setq obj (vlax-ename->vla-object ent))
        (setq bbox (getboundingbox obj)
              llc (car bbox)
              urc (cadr bbox)
              mpt (list (/ (+ (car llc) (car urc)) 2) (/ (+ (cadr llc) (cadr urc)) 2))
        )

        (setq obj_length (vlax-get-property obj 'LENGTH))
        (setq txt (strcat (rtos (/(* obj_length 200)1000))))
        (command "text" "j" "mc" mpt (* (getvar "dimscale") 2.5) "0" (strcat txt " m"))
        (princ)
      )
    )
  )
(command ".undo" "end")
(princ)
(*error* "")
(setvar 'clayer u-clayer)
(princ (strcat (itoa index) " entities processed..."))
(princ)
)

[whdjr]

Here's my attempt at it:

Code: [Select]

(defun c:ll (/ ss pt dis ent pts)
;;;
  (defun remove (ent)
    (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent))
  )
;;;
  (defun dist (lst / d)
    (setq d (list (distance (car lst) (cadr lst))))
    (if (> (length (setq lst (cdr lst))) 1)
      (append d (dist lst))
      d
    )
  )
;;;
  (Prompt "\nSelect Polyline:  ")
  (if (and (setq ss (ssget ":S:E" '((0 . "LWPOLYLINE"))))
  (not (initget 1))
  (setq pt (getpoint "\nPick for Text location: "))
      )
    (and (setq ent (entget (ssname ss 0)))
(if (= (cdr (assoc 70 ent)) 1)
  (setq pts (append (setq pts (remove ent)) (list (car pts))))
  (setq pts (remove ent))
)
(setq dis (/ (* 200 (apply '+ (dist pts))) 1000))
(not (command "text"
      "justify"
      "bc"
      pt
      "2.5"
      ""
      (strcat (rtos dis 2) "m")
     )
)
    )
    (princ "\nERROR: Nothing Selected! ")
  )
)

[daron]

Ron, did you write that? If so, I'm amazed. You've come a long way.

[ronjonp]

I got help with alot of it but I'm starting to pick it up finally.

[jbaxter]

Thank you guys, it is really appreciated.

I will give the routines a workout today!!

Kind Regards,
John

[CAB]

Ok, i got one.

Code: [Select]

;;  CAB  05/04/2005
;;  Pline length print
(defun c:plen? (/ en len pt txt)
  (vl-load-com)
  (and
    (setq en (entsel "\nPick polyline for length."))
    (setq en (car en))
    (member (cdr (assoc 0 (entget en))) '("LWPOLYLINE" "POLYLINE"))
    (setq len (vlax-curve-getdistatparam en (vlax-curve-getendparam en)))
    (null (initget 1))
    (setq pt (getpoint "\nPick Text location: "))
    (setq txt (strcat (itoa (fix (+ (/ (* 200 len) 1000) 0.9999))) "m"))
    (if (= (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
      (command "text" pt "2.5" 0 txt) ;set text height
      (command "text" pt 0 txt); Otherwise use the defined text height
    )
  )
  (princ)
)
(prompt "\nPline Length Print loaded, Enter plen? to run")
(princ)

[jbaxter]

Routines work great chaps, saved me heaps of time today under pressure!!

Regards,
JB

[whdjr]

So who's the winner?  Which one are you using?  Who gets the grand prize?...eh...eh?

Just kidding...We are all glad we could help.