Specific line length

I am looking for a lisp routine that will allow for me select all lines of a
specific length. The one I currently and using does not work the way I want.
For example it will work on lines of say 1" but will not work with lengths
of 3.875". Finding the problem in the routine below is beyond me.

Thanks.

(defun c:linelength()
(if (not asked-length)(setq asked-length 660.0)) ; just a length
(setq answer-asked-length (getreal (strcat "Enter length <" (rtos
asked-length) ">:")))
(if answer-asked-length (setq asked-length answer-asked-length))
(setq tolerance 1e-12)
(setq entity-list nil)
(setq entity-list (ssadd)) ; create new, empty selection set

(setq teller 0)
(setq entlyst (ssget "X")) ; select every thing in the drawing
(setq entlystl (sslength entlyst))

(while (< teller entlystl) ; test through all entities
(setq entityname (ssname entlyst teller))
(setq entdatalyst (entget(ssname entlyst teller)))
(setq enttype (cdr(assoc 0 entdatalyst)))

(if (= enttype "LINE") ; test if entity is a line
(progn

(setq assoc10 (assoc 10 entdatalyst))
(setq p10 (cdr assoc10)) ; WCS coordinates
(setq p10 (trans p10 0 1)) ; UCS coordinates

(setq assoc11 (assoc 11 entdatalyst))
(setq p11 (cdr assoc11)) ; WCS coordinates
(setq p11 (trans p11 0 1)) ; UCS coordinates

(setq line-length (distance p10 p11))

(if (< (abs(- line-length asked-length))tolerance) ; test length of line
(setq entity-list (ssadd entityname entity-list))
)

);progn
);if

(setq teller (+ 1 teller))
);while

(setq set entity-list) ; short name for the set of selected objects
(princ (sslength set))(princ " lines selected")(princ)
(princ ", Call this set in responce to 'select objects' with: !set")(princ)
);defun

(princ "\nStart command: linelength")(princ)

 

Ok, it will work on lines *.875 or what ever. But, if I crank up the units
percision to 1/256 the line is actually *-115/128 and it will not select
them.
Thanks, again.

 

Same result. Qselect will work for lines of say 3.875" but will not select
3-115/128", regardless of the format ( 3.8984375" for example) I use.

 

Hi Caved

How about this:
(defun SelLinesByLength ( / CurEnt CurSet EntCnt LinLgt TmpStr TmpLen)
(vl-load-com) ;initialize ActiveX support
(or Gb:Len (setq Gb:Len 1.0)) ;set default length
(if (setq CurSet (ssget "X" '((0 . "LINE")))) ;filter for line(s)
(progn ;if line(s) found...
(initget 6) ;not zero or negative
(setq TmpStr (strcat "\nLine length for filter <" (rtos Gb:Len) ">: ")
TmpLen (getdist TmpStr) ;get length
Gb:Len (cond (TmpLen) (Gb:Len)) ;set to user input or default
EntCnt 0 ;set entity counter
)
(repeat (sslength CurSet) ;scan selection set
(setq CurEnt (ssname CurSet EntCnt) ;extract entity
LinLgt (vla-get-Length ;get the length of the
(vlax-ename->vla-object CurEnt) ;line object
)
)
(if (equal Gb:Len LinLgt 1e-8) ;if length ~equal...
(setq EntCnt (1+ EntCnt)) ;get next entity
(ssdel CurEnt CurSet) ;else... remove entity
) ;from selection set
)
)
)
CurSet ;return selection set
)

Cheers

 

The following error is returned when running the below routine.

Command: matchlines
no function definition: SELLINESBYLENGTH

Any help is appreciated as I am trying to learn this stuff and get the job
done at the same time.

Thanks,

(defun C:MatchLines ( / CurSet)
(if (setq CurSet (SelLinesByLength))
(alert (strcat (itoa (length CurSet)) " matching line(s) found.")
(alert "No matching lines found.")
)
(princ)
)
defun SelLinesByLength ( / CurEnt CurSet EntCnt LinLgt TmpStr TmpLen)
(vl-load-com) ;initialize ActiveX support
(or Gb:Len (setq Gb:Len 1.0)) ;set default length
(if (setq CurSet (ssget "X" '((0 . "LINE")))) ;filter for line(s)
(progn ;if line(s) found...
(initget 6) ;not zero or negative
(setq TmpStr (strcat "\nLine length for filter <" (rtos Gb:Len) ">: ")
TmpLen (getdist TmpStr) ;get length
Gb:Len (cond (TmpLen) (Gb:Len)) ;set to user input or default
EntCnt 0 ;set entity counter
)
(repeat (sslength CurSet) ;scan selection set
(setq CurEnt (ssname CurSet EntCnt) ;extract entity
LinLgt (vla-get-Length ;get the length of the
(vlax-ename->vla-object CurEnt) ;line object
)
)
(if (equal Gb:Len LinLgt 1e-8) ;if length ~equal...
(setq EntCnt (1+ EntCnt)) ;get next entity
(ssdel CurEnt CurSet) ;else... remove entity
) ;from selection set
)
)
)
CurSet ;return selection set
)

 

(defun c:findline (/ len fuzz ss i en ed ls)

;;;SPECIFY LINE LENGTH
(initget 7)
(setq len (getdist "\nLine Lengths To Find: "))

;;;GET FUZZ FACTOR
(initget 6)
(setq fuzz (getreal "\nFuzz Factor For Equal Line Length <1e-8>: "))
(and (not fuzz)
(setq fuzz 1e-8))

;;;FIND LINES
(and (setq ss (ssget '((0 . "LINE"))))
(setq i (sslength ss)
ls (ssadd))
(while (not (minusp (setq i (1- i))))
(setq en (ssname ss i)
ed (entget en))
(if (equal len (distance (cdr (assoc 10 ed))
(cdr (assoc 11 ed))) fuzz)
(ssadd en ls))))

(command "_.SELECT" ls ""))

;|-David

 

<clip>
defun SelLinesByLength ( / CurEnt CurSet EntCnt LinLgt TmpStr TmpLen)

<clip>

must be

(defun SelLinesByLength ( / CurEnt CurSet EntCnt LinLgt TmpStr TmpLen)

note the "("
....