SSGET two perpendicular pline

[Anonymous]

Hi all,

I have been working on a drawing which contains numerous number of exploded EARTH blocks. Apart from their rotation angle, they are all the same i.e. they are all plines, they have same color, same layer, etc.

See screenshot below (other stuff are frozen):

I was wondering if I could use SSGET and replace them with their correspondent block (their angle should be maintained). Again, please see screenshot below:

My idea was to grab all pline objects which are on layer Existing Symbol and have the length of "1". And then check whether there is another pline with the same layer and length of "3" perpendicular to that. From there I would be pretty certain that I have successfully identified an instance of exploded symbol. Next I am going to do another SSGET with "W" option to somehow grab the entire thing, delete it and replace it by the block.

That's my plan but for beginning, I am not sure how to do test whether two plines are perpendicular.

Can anyone help please?

Regards

[john.uhden]

Here's some stuff that passed though my mind just now...

(defun @ends (e)
  (list (vlax-curve-getpointatparam e 0)(vlax-curve-getpointatparam e 1))
)
(defun @midp (ends)
   (mapcar '* '(0.5 0.5 0.5)(mapcar '+ (car ends)(cadr ends)))
)
;;-----------------------------------------------------------------------
;; This function returns the deflection angle (in radians) of two angles:
;;
(defun @delta (a1 a2)
   (cond
      ((> a1 (+ a2 pi))
         (setq a2 (+ a2 pi pi))
      )
      ((> a2 (+ a1 pi))
         (setq a1 (+ a1 pi pi))
      )
   )
   (- a2 a1)
)

(defun @match (e1 e2 / ends1 ends2 delta)
  ;; where e1 is a 3-unit and e2 is a 4-unit
  (and
    (setq ends1 (@ends e1) ends2 (@ends e2))
    (setq p (inters (append ends1 ends2) nil))
    (or (equal p (car ends1) 0.001)(equal p (cadr ends1) 0.001))
    (equal p (@midp ends2) 0.001)
    (setq delta (@delta (apply 'angle ends1)(apply 'angle ends2)))
    (or
      (equal delta (* pi 0.5) 0.0001)
      (equal delta (* pi 1.5) 0.0001)
      (equal delta (* pi -0.5) 0.0001)
      (equal delta (* pi -1.5) 0.0001)
    )
  )
)

[john.uhden]

This is totally untested, but it just might work.  I couldn't resist playing.

Check the layer and insert names in the ssget and entmake.

(defun c:UNEXPLODE (*error* cmdecho Doc ss1 ss2 ss3 ss4 i e len match @ends @delta @mid @match)
  (setq Doc (vlax-get (vlax-get-acad-object) 'ActiveDocument))
  (setq cmdecho (getvar "cmdecho"))
  (defun *error* (error)
    (setvar "cmdecho" cmdecho)
    (vla-endundomark Doc)
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error))
        (if OK (princ (strcat "\nOK=" (itoa ok))))
      )
    )
    (princ)
  )
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (setvar "cmdecho" 0)
  (command "_.expert" (getvar "expert")) ;; dummy command

  (defun @ends (e)
    (list (vlax-curve-getpointatparam e 0)(vlax-curve-getpointatparam e 1))
  )
  (defun @midp (ends)
     (mapcar '* '(0.5 0.5 0.5)(mapcar '+ (car ends)(cadr ends)))
  )
  ;;-----------------------------------------------------------------------
  ;; This function returns the deflection angle (in radians) of two angles:
  ;;
  (defun @delta (a1 a2)
     (cond
        ((> a1 (+ a2 pi))
           (setq a2 (+ a2 pi pi))
        )
        ((> a2 (+ a1 pi))
           (setq a1 (+ a1 pi pi))
        )
     )
     (- a2 a1)
  )

  (defun @match (e1 e2 / ends1 ends2 delta match)
      ;; where e1 is a 3-unit and e2 is a 4-unit
      ;; if all tests are met, it returns a list in the format (ang x y z)
      (and
        (setq ends1 (@ends e1) ends2 (@ends e2))
        (setq p (inters (append ends1 ends2) nil))
        (or (equal p (car ends1) 0.001)(equal p (cadr ends1) 0.001))
        (equal p (@midp ends2) 0.001)
        (setq delta (@delta (apply 'angle ends1)(apply 'angle ends2)))
        (or
          (equal delta (* pi 0.5) 0.0001)
          (equal delta (* pi 1.5) 0.0001)
          (equal delta (* pi -0.5) 0.0001)
          (equal delta (* pi -1.5) 0.0001)
        )
        (if (equal p (car ends1) 0.001)
          (setq match (cons (angle (cadr ends1) p)(cadr ends1)))
          (setq match (cons (angle (car ends1) p)(car ends1)))
        )
      )
      match
  )
  ;; BEGIN THE ACTION
  (and
    (setq ss1 (ssget "x" '((0 . "LWPOLYLINE")(8 . "Existing Symbols")(410 . "Model"))))
    (repeat (setq i (sslength ss1))
      (setq e (ssname (setq i (1- i)))
                 len (apply 'distance (@ends e))
      )
      (cond
        ((equal len 3 0.01)(setq ss3 (cons e ss3)))
        ((equal len 4 0.01)(setq ss4 (cons e ss4)))
        (1)
      )
    )
    (foreach e ss3
      (setq ss2 ss4 match nil)
      (while (and ss2 (not match))
        (setq match (@match e (car ss2)) ss2 (cdr ss2))
      )
      (if match (entmake (list '(0 . "INSERT")'(2 , "EARTH")'(8 . "Existing Symbols")(cons 10 (cdr match))'(41 . 1.0)'(42 . 1.0)'(43 . 1.0)(cons 50 (car match)))))
      1
    )
    (vl-cmdf "_.ERASE" ss1 "")
  )
  (*error* nil)
)

[Anonymous]

Thanks John. I am glad you couldn't resist the temptation 🙂

I get an error though which I couldn't figure out why:

Command: UNEXPLODE
; error: too few arguments

I also tried adding a slash to the first defun but that wasn't the case either:

(defun c:UNEXPLODE ( / *error* cmdecho Doc ss1 ss2 ss3 ss4 i e len match @ends @delta @mid @match)

[john.uhden]

As I said... "untested."

I'll figure it out.  Plus I should download your DWGs and test it out myself.

That was easy.  I think I found the argument error.

Here... try it again

[Anonymous]

Still not good. Same error. I tried to compile line-by-line way. It turned out the problem is on this line (I think):

(setq match (@match e (car ss2)) 
      ss2 (cdr ss2)
)

[john.uhden]

Nope. It was in another place.  I was trying to do a Ranjit kind of thing on the inters line.

Please try again.

[Anonymous]

I did test it again but problem still exist. 

Do you mind trying the code on your end? Maybe something wrong with my machine (!)

PS. what does "Ranjit kind of thing" exactly mean I wonder?

[john.uhden]

Yes, I will try it maybe after dinner (It's 7:12 pm right now).  I just have to cook the veggies on the grill.

[Anonymous]

Bon appetit.

[john.uhden]

Well, it appears to work now, except that it erases all the polylines, a number of which should have been kept.  It would be a lot more work to sift out was was to stay vs. go.

It's too bad that all this work can serve just one purpose, but if you can learn from it then that's just fine.

[Anonymous]

Shes not the only one learning 😛 Thanks!

[ActivistInvestor]

---

@Anonymous wrote:

Good strategy. But that would still require a relatively exact transformed match between the block geometry and the geometry of the copies, wouldn't it?  Only an approximate match is available in the sample and that might be fooled by other similar symbols.  As I said, even the copies are dissimilar from one another to some degree, not just rotationally.

---

I'm not sure I follow. There is no such thing as 'exact' when it comes to 64-bit IEEE floating-point doubles. Are you talking about something > 1.0e-6 ? If so, I'm not seeing that in the data that was posted by the OP. What I see (if that is what you are referring to as 'approximate') is what appears to be the artifacts of floating-point roundoff that is common with geometry that lies at great distances from the origin. In case you didn't know this, the ACIS modeler in AutoCAD uses a global tolerance of 1.0e-6 to mitigate problems that can result from floating-point round-off.

The orientation of the first line in the block definition correlates to the orientation of the first exploded copy of that line, so the rotation angle of what was the block insertion is calculated by taking the difference between the orientation of the definition entity and the orientation of the corresponding exploded copy. That gives us the rotational component of the transformation, leaving only the translation component, which is the start point of the first line/polyline in the block definition, keeping in mind that none of this would work with exploded insertions that were inserted at any scale other than 1.1, without significantly-more work.

[john.uhden]

Good for you!

[john.uhden]

BTW, with just a little more code we can retain the polylines that are attached to the insertion point of each block.  Would that be an improvement?

[Anonymous]

---

@john.uhden wrote:

BTW, with just a little more code we can retain the polylines that are attached to the insertion point of each block.  Would that be an improvement?

---

Definitely yes! (please)

----------

Now I have a question (from a beginner who is trying to learn):

I line #103 of the code, there is distance command:

(apply 'distance (@ends elemnt))

I noticed the reason that the current code is deleting whole heaps of object than what it should to, is when the code reaches to this line of code, it drops the measurement precision from 3.3541 to 3.0 for instance. And that is the reason a lot of objects fall into following cond:

(cond
        ((equal len 3   0.01)
			(setq ss3 (cons elemnt ss3))
		)
        ((equal len 4.5 0.01)
			(setq ss4 (cons elemnt ss4))
		)
        (1)
      )

On the other hand, if I use

(setq cEnt (car (entsel "\nSelect Object: ")))

and then use 

(apply 'distance (@ends cEnt))

I get the exact value of 3.3541 (in above imaginary example).

Why does AutoCAD do that? I mean distance command behaves differently if its argument is selected by user via entsel  (externally) vs. passing the argument into it via SSGET (internally)?

John's code is attached with some minor cosmetics.

[john.uhden]

Hi there.  I have been thinking about this and know that I cam make it work perfectly.

But to answer your question(s)...

(apply 'distance (@ends elemnt))

is just my compact way of getting the straight distance from one end of an entity name to the other.  Actually, it presumes that all the polylines on that layer in your drawing have only two vertices, a beginning and an end.  Since @ends returns a list of two points ((x1 y1 z1)(x2 y2 z2)), (apply 'distance ...) is the same as (eval (cons 'distance (@ends ...))).  Many of us around here like to compact things.  It's sort of a one-upsmanship thing.  You know how guys are, though @ВeekeeCZ is as good as anyone. (I'm pretty sure she is female and probably has to beat away suitors).  Although Laurie Comerford from Australia had me confused for a while, until he came to visit me...
A very cool bloke.

(setq cEnt (car (entsel "\nSelect Object: ")))

is just another means of getting an entity name, so (@ends ...) will work with that just fine.  In fact, because the vlax-curve functions work with both enames and vla-objects, you could use it with a vla-object object as well.

BTW, I wasn't "dropping the measurement precision."  It's just that (equal this that fuzz) is more forgiving than (= this that).  = is good for comparing strings and integers, but floating point reals may be close but never exact.  In your case, all the 3-unit polylines might really be exactly 3 units long, but you never know what distance value you may get when their end points are in outer space somewhere.  The distance may come back as 2.999999999 or 3.0000000001, so using a fuzz factor of 0.001 places either value in the range of 3.0, as in "close enough."

I haven't looked at your cosmetic makeover (face-lift?) but do you want me to  perform some surgery to delete only those polylines that were part of an exploded block insertion?  My technique will be to test for parallelity and proximity to the 4.5 unit polyline added to ss4.  That way the ones that, for instance, connect the block insertion point to a circle are left to remain.

[Anonymous]

I am kind of nervous now to answer 'YES' to your last paragraph's question. I think I am asking too much from you by saying so 😕

Obviously you have been generous enough to do this code for me. But if you can develop it further, I would appreciate it.

About the answer you provided to my question, I am still confused. Same command applied to same object, gets two different precision in the results. How's that possible?

I apply distance command on an object which has been selected by entsel, I get higher precision in the results compared to a situation I apply distance command to the same object grabbed via SSGET.

[john.uhden]

@Anonymous wrote:

"About the answer you provided to my question, I am still confused. Same command applied to same object, gets two different precision in the results. How's that possible?

I apply distance command on an object which has been selected by entsel, I get higher precision in the results compared to a situation I apply distance command to the same object grabbed via SSGET."

You are just looking at the displayed value.  Try capturing the value to a symbol, say d, and then (rtos d 2 16).  You will see a whole lotta numbers after the decimal.  Another way for testing "close enough" equality would be to convert the numbers to strings.  Let's say A was 2.99 and B was 3.01, or just watch:

Command: (setq A 2.99 B 3.01)
3.01
Command: (equal A B 0.01) nil
Command: (rtos A 2 16) "2.990000000000000"
Command: (rtos B 2 16) "3.009999999999999"
Command: (rtos A 2 1) "3.0"
Command: (rtos B 2 1) "3.0"
Command: (= (rtos A 2 1)(rtos B 2 1)) T
Command: (equal A B 0.1) T

Notice how B seemed to lose its exactitude?  Weird stuff happens with reals.  As programmers we have to have a good sense about what size fuzz factor to use.  Oh, and the equal function can be used to compare 3D point lists as well.  So I am not recommending the use of comparing rtos values; it's just that it can also work for one-dimensional numbers (if you know the constraints).

[Anonymous]

Thanks for your thorough explanation John.

[john.uhden · Accepted solution]

The attached seems to work the best.  It deletes all the siblings of the exploded block insertion, but leaves all the others, which means there may be redundant code to keep the "touching" ones.  I'll see if you can figure out what I mean.