Help with Qselect LISP for quality control.

[Anonymous]

Hello,

I have encountered a situation in which I know a LISP routine would be ideal, but I have yet to fully wrap my head around it.

The situation I have is that my Job has me merging and reviewing drawings from multiple different drafters, an issue with this is some line work not matching to appropriate angles, think 45.10 degrees instead of 45.00.

Currently I can use QSELECT to select all the lines that are correct at 0, 45, 90, 135, 180, 225, 270, and 315 degrees individually and change their color to allow me to focus in on the lines that have not been drawn correctly. Unfortunately, I have to run QSELECT for each different angle, and I know that having a LISP to execute these 8 commands for me would be far more ideal.

I am not worried about Poly lines as we do not utilize them. I am hoping someone can at least point me in the right direction, or maybe even enlighten me to a better method than I currently use.

Thanks

[Kent1Cooper]

Maybe you can get a start from LinesRegularizeAngles.lsp with its LRA command, available >here<.  If you use that and give it 45 degrees for the angle-multiple value, it will force all selected Lines to fall on whichever of those angles is closest to its current direction, all at once for all such directions.  It has an option whether to do it to the original Lines or to copies on a new Layer.  It could be modified easily enough, I think, to instead identify those that are not  already at one of those, and either select/grip/highlight only those, or put and fix copies of only those on a different Layer [leaving alone those already at good angles], or something.  The latter may be preferable, because the way it regularizes a Line's angle is to Rotate the Line about its midpoint, so you would want to know which ones it did, so you can check where their endpoints  ended up and see the result in comparison to their original positions, and make any adjustments.

[dlanorh · Accepted solution]

Try this :

(vl-load-com)

(defun c:test (/ *error* c_doc ang_lst ss obj ang)
  
  (defun *error* ( msg )
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
    (princ)
  );end_*error*_defun
	
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        ang_lst (list 0.0 (* pi 0.25) (* pi 0.5) (* pi 0.75) pi (* pi 1.25) (* pi 1.5) (* pi 1.75) (* pi 2))
        ss (ssget "_X" '((0 . "LINE")))
  );end_setq
	
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (repeat (setq cnt (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
          ang (vlax-get-property obj 'angle)
    );end_setq      
    (if (not (vl-position ang ang_lst)) (vlax-put-property obj 'color 192))
  );end_repeat
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
);end_defun 

[Kent1Cooper · Accepted solution]

---

@dlanorh wrote:

....

....
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        ang_lst (list 0.0 (* pi 0.25) (* pi 0.5) (* pi 0.75) pi (* pi 1.25) (* pi 1.5) (* pi 1.75) (* pi 2))
....
   (if (not (vl-position ang ang_lst)) (vlax-put-property obj 'color 192))
....

---

That routine might suffer from the numerical-value comparison issue that sometimes comes up, where a number [such as the 'ang' variable for a given Line] is "good" but strictly speaking is off 14 or 15 or so decimal places down, which will make it fail.  In addition to accounting for that, I think you could eliminate that ang_lst list variable entirely, and use (rem), replacing the red part quoted [which is going to want utter and precise equality] with this:

(if (not (or (equal (rem ang (/ pi 4)) 0 1e-6) (equal (rem ang (/ pi 4)) (/ pi 4) 1e-6))) (vlax-put-property obj 'color 192))

You could very likely get by with "cruder" precision, such as 1e-4 instead of 1e-6.

The second (equal) function there is included because if a Line aims at [for example] 0 degrees, its 'ang' could  sometimes come out at not truly 0, but something like 0.000000000000001 less than 2 pi.  If so, its (rem) return won't be close to 0, but close to the radian equivalent of 45 degrees.

[dlanorh]

---

@Kent1Cooper wrote:

---

The second (equal) function there is included because if a Line aims at [for example] 0 degrees, its 'ang' could  sometimes come out at not truly 0, but something like 0.000000000000001 less than 2 pi.  If so, its (rem) return won't be close to 0, but close to the radian equivalent of 45 degrees.

---

Good catch Kent

[Anonymous]

Thanks,

This with the small tweak is perfect.

[dlanorh]

Tweaked lisp attached.