Autolisp to highlight/select lines with decimal in length for quality control

[agproj]

I'm trying to automate as much as I can for us and I'm just starting out in Lisp.

I've already found a script control of odd angles that'll be used a lot.

Now I'm in need of getting a script that'll let us check files for odd length lines.
An example would be a line that's 4000.0753 long (or basically has any length that's not in whole work units).

 

Best would be just changing the color or selecting those objects so I can send it back to get it fixed.

[Mugna101]

Interested for the script logic of it.

 

 

how would u write down to check if a number is indeed a round number?

 

 

 

[mhupp]

6 hours ago, Mugna101 said:

how would u write down to check if a number is indeed a round number?

 

Use the function fix.  then compare that to the actual length. You can adjust how accurate you want it by changing the if statement.

 

(if (> (- len flen) 0) = anything that's not a whole number

(if (> (- len flen) 0.250) = anything #.250 - #.999

 

(defun C:CHECK (/ SS ent e poly len flen)
  (vl-load-com)
  (setq SS (ssget "_X" '((0 . "*LINE"))))
  (foreach ent (mapcar 'cadr (ssnamex SS))
    (cond
      ((= (cdr (assoc 0 (setq e (entget ent)))) "LINE")
        (setq len (distance (cdr (assoc 10 e)) (cdr (assoc 11 e))))
        (setq flen (fix len))
        (if (> (- len flen) 0)
          (entmod (append (entget ent) '((62 . 1))))
        )
      )
      (t
        (setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
        (setq flen (fix len))
        (if (> (- len flen) 0)
          (entmod (append (entget ent) '((62 . 1))))
        )
      )
    )
  )
)

 

Edited October 26, 2021 by mhupp
update code

[ronjonp]

@mhupp FWIW, You don't need to convert ename to object when using curve functions .. it's actually faster! 

(setq e (car (entsel)))
(setq o (vlax-ename->vla-object e))
(benchmark '((vlax-curve-getdistatparam e (vlax-curve-getendparam e))
	     (vlax-curve-getdistatparam o (vlax-curve-getendparam o))
	    )
)
;;;Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):
;;;
;;;    (vlax-curve-getDistAtParam E (vlax-c...).....1500 / 1.85 <fastest>
;;;    (vlax-curve-getDistAtParam O (vlax-c...).....2781 / 1.00 <slowest>
;;;
;;;---- Benchmark Utility: In memory of Michael Puckett ----

 

Edited October 26, 2021 by ronjonp

[mhupp]

Thanks @ronjonp always dropping nuggets!

 

Also i tried to use like in the ssget function

((= (cdr (assoc 0 e)) "*POLYLINE")

But it didn't seem to work.

 

--EDIT-- I guess sinces its already filter with ssget I'll just use t

Edited October 26, 2021 by mhupp

[ronjonp]

31 minutes ago, mhupp said:

Thanks @ronjonp always dropping nuggets!

 

Also i tried to use like in the ssget function

((= (cdr (assoc 0 e)) "*POLYLINE")

But it didn't seem to work.

 

--EDIT-- I guess sinces its already filter with ssget I'll just use t

You'd need to use WCMATCH since you're using a wildcard.

[ronjonp]

I'd probably approach it like so:

(defun c:foo (/ _getlength l s)
  (defun _getlength (e / ep)
    (if	(vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
      0.
      (vlax-curve-getdistatparam e ep)
    )
  )
  (if (setq s (ssget "_X" '((0 . "~INSERT"))))
    (foreach e (mapcar 'cadr (ssnamex s))
      (if (> (- (setq l (_getlength e)) (fix l)) 0)
	(entmod (append (entget e) '((62 . 1))))
      )
    )
  )
  (princ)
)

 

Edited October 26, 2021 by ronjonp

[BIGAL]

Is the get-length any faster or way slower ? Just interested. 

 

(benchmark 
'(vla-get-length (vlax-ename->vla-object (car (entsel))))
'(vlax-get (vlax-ename->vla-object (car (entsel))) 'Length))

 

[Mugna101]

12 hours ago, ronjonp said:

I'd probably approach it like so:

(defun c:foo (/ _getlength l s)
  (defun _getlength (e / ep)
    (if	(vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
      0.
      (vlax-curve-getdistatparam e ep)
    )
  )

 

 

This whole vl and vlax stuff is very confusing to me. 

can someone please explain this part of the code?

what is it intended to do

[agproj]

So it turns out that the code is completely useless for me. The reason isn't that it does not work. The reason is exactly the opposite; it works far too well.

 

The precision in the files seems to be the issue because even though I've input the dimensions without decimals (for testing), the lines did get highlighted.

Thanks for the code but I don't see a way to make it work for me. 

To show you, I'm attaching a .dwg with four lines, where three were input with "exact" length and orthogonal angles.

Test DWG.dwg

[mhupp]

5 hours ago, agproj said:

So it turns out that the code is completely useless for me. The reason isn't that it does not work. The reason is exactly the opposite; it works far too well.

 

like i said its adjustable. It all depends on how accurate you wanted it. Yes you put in precision distances. when its running the code its finding a difference of

2.27373675443232e-013 witch is 0.0000000000002273 a very small number but its still greater then 0. so it changes the entity  red.

 

 

 if you update Ronjon's code to have a tolerance

(if (and (> (- (setq l (_getlength e)) (fix l)) 0.001) (< (- l (fix l)) 0.999))

 

or my code

(if (and (> (- len flen) 0.001) (< (- len flen) 0.999))

 

this is what you will get

 

Edited October 27, 2021 by mhupp

[agproj]

5 minutes ago, mhupp said:

 

like i said its adjustable. It all depends on how accurate you wanted it. Yes you put in precision distances. when its running the code its finding a difference of

2.27373675443232e-013 witch is 0.0000000000002273 a very small number but its still greater then 0. so it changes the entity  red.

 

If you update my code to have a tolerance to your liking

(if (and (> (- len flen) 0.001) (< (- len flen) 0.999))

 

or Ronjon's

(if (and (> (- (setq l (_getlength e)) (fix l)) 0.001) (< (- l (fix l)) 0.999))

 

this is what you will get

 

 

17 hours ago, ronjonp said:

I'd probably approach it like so:

(defun c:foo (/ _getlength l s)
  (defun _getlength (e / ep)
    (if	(vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
      0.
      (vlax-curve-getdistatparam e ep)
    )
  )
  (if (setq s (ssget "_X" '((0 . "~INSERT"))))
    (foreach e (mapcar 'cadr (ssnamex s))
      (if (> (- (setq l (_getlength e)) (fix l)) 0)
	(entmod (append (entget e) '((62 . 1))))
      )
    )
  )
  (princ)
)

 

Thanks a ton! This will be a huge help for all the files we're working on!

[mhupp]

@ronjonp You mind sending me he benchmark lisp?

[ronjonp]

12 minutes ago, mhupp said:

@ronjonp You mind sending me he benchmark lisp?

Here you go.

benchmark.lsp

[ronjonp]

16 hours ago, BIGAL said:

Is the get-length any faster or way slower ? Just interested. 

 

(benchmark 
'(vla-get-length (vlax-ename->vla-object (car (entsel))))
'(vlax-get (vlax-ename->vla-object (car (entsel))) 'Length))

 

It probably is, but it's not as robust as the curve function since it can handle many more object types [SPLINE, ELLIPSE, ETC...]

 

Here are the benchmarks:

(setq o (vlax-ename->vla-object (setq e (car (entsel)))))
(defun _getlength (e / ep)
  (if (vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
    0.
    (vlax-curve-getdistatparam e ep)
  )
)
(benchmark '((vla-get-length o)
	     (vlax-get o 'length)
	     (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
	     (_getlength e)
	    )
)
;;;_GETLENGTH Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):
;;;
;;;    (vlax-curve-getDistAtParam E (vlax-c...).....1547 / 1.34 <fastest>
;;;    (_GETLENGTH E)...............................1547 / 1.34
;;;    (vlax-get O (QUOTE LENGTH))..................1985 / 1.05
;;;    (vla-get-Length O)...........................2078 / 1.00 <slowest>
;;;
;;;---- Benchmark Utility: In memory of Michael Puckett ----

 

Edited October 27, 2021 by ronjonp

[ronjonp]

2 hours ago, agproj said:

 

Thanks a ton! This will be a huge help for all the files we're working on!

You're welcome! 

[Steven P]

So back to the OP, what do you do with the lines once you have identified that are fractions too long or short?

 

[agproj]

On 10/27/2021 at 10:03 PM, Steven P said:

So back to the OP, what do you do with the lines once you have identified that are fractions too long or short?

 

This topic could already be marked as solved (if such thing exists on this forum), because it already does all I need.

We are all working in a software that does fill a lot of non graphic data into the CAD model so we can't change the model in Autocad automatically or anything. We need to fix the issues in the original file the .dwg got exported from.
Since the models are objects based, it's not that much of a hassle to fix.

[Manila Wolf]

I only have a minimal understanding of lisp, I am curious to know if somebody could adjust the code so that it only highlights the lengths that deviate from lengths that are drawn accurately to a whole number and numbers to one decimal place.

i.e. Highlight lengths having 2 decimal places or more.

 

examples: -

Length = 50 (Code does not highlight)
Length = 50.3 (Code does not highlight)
Length = 50.33 (Code does highlight)
Length = 50.333 (Code does highlight)

[mhupp]

2 hours ago, Manila Wolf said:

Highlight lengths having 2 decimal places or more.

Added another sub function to @ronjonp lisp count the decimal places of the length.

 

(defun c:foo (/ _getlength _DecimalPlaces l s)
  (defun _getlength (e / ep) ;get lenght of entity
    (if (vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
      0.
      (vlax-curve-getdistatparam e ep)
    )
  )
  (defun _DecimalPlaces (r) ;returns count of decimal numbers
    (1- (length (member 46 (vl-string->list (vl-princ-to-string r)))))
  )
  (if (setq s (ssget "_X" '((0 . "~INSERT"))))
    (foreach e (mapcar 'cadr (ssnamex s))
      (if (and (setq l (_getlength e)) (>= (_DecimalPlaces l) 2))
        (entmod (append (entget e) '((62 . 1))))
      )
    )
  )
  (princ)
)