lisp to drop line vertices by inserted block attribute entry

[raichu692003791074]

The survey teams I'm working with at the moment don't have access to 12d, C3d, or any higher end software, or any survey processing software.

I've got a suite of LISPs that I use to process survey data in AutoCAD vanilla and I need to be able to take the insertion point z value of a survey point block, access the depth attribute of that block, and apply it (downwards obviously) to the line vertices that coincide with the X,Y of that block, and I cannot for the life of me hack something together that does this.

The survey points have an attribute called "Z" but that attribute does not show the true elevation of the point if the survey has been adjusted to suit a reference height, the LISP must use the insertion point value.

There are a number of different blocks, the blocks in the example dwg are "DIAG_CROSS_4", and are the only blocks to be used for this operation.

I have no option to use anything else in the way of software or plug-ins or apps etc.

The surveyors are using a mixture of AutoCAD and BricsCAD, not that I think that will change anything for this operation (it's be so easy with a 12d license).

The plan would be to get a LISP that does this operation and then chain it into a start-up LISP they use when they start drafting/processing. So, apply it to every instance in the drawing not manually select the entities.

I've attached a sample drawing.

Thanks in advance.

[raichu692003791074]

attached file to this reply....sigh

[marko_ribar]

I have a question :
What is priority : coordinates of attribute input (all 3 - X,Y,Z), or block insertion point.?
If attributes input are first thing to check, in what scenario are you in need to acquire block insertion point.? - haven't understood very clearly -
For me and IMHO - as I can see, all blocks have populated values of X,Y,Z coordinates... I am right that you need to change then both and insertion point of block and corresponding connection LINE end point position according to attribute values.?

Let me try it very simply in fly :

(defun c:foo-remedy-lines+insert-positions_attdata ( / ss i e x y z p ex bll lil bp p1 p2 lix lst lstt )

  (vl-load-com)

  (if (setq ss (ssget "_:L" '((0 . "LINE,INSERT"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (if (= (cdr (assoc 0 (setq ex (entget e)))) "LINE")
          (setq lil (cons e lil))
          (if
            (and
              (assoc 66 ex)
              (equal (assoc 66 ex) (cons 66 1))
              (= (cdr (assoc 2 ex)) "DIAG_CROSS_4")
            )
            (setq bll (cons e bll))
          )
        )
      )
      (foreach bl bll
        (setq e bl)
        (while (and e (setq e (entnext e)))
          (cond
            ( (= (cdr (assoc 2 (setq ex (entget e)))) "X")
              (setq x (cdr (assoc 1 ex)) x (atof x))
            )
            ( (= (cdr (assoc 2 (setq ex (entget e)))) "Y")
              (setq y (cdr (assoc 1 ex)) y (atof y))
            )
            ( (= (cdr (assoc 2 (setq ex (entget e)))) "Z")
              (setq z (cdr (assoc 1 ex)) z (atof z))
            )
            ( (= (cdr (assoc 0 (setq ex (entget e)))) "SEQEND")
              (setq e nil)
            )
          )
        )
        (if
          (and
            x
            (numberp x)
            y
            (numberp y)
            z
            (numberp z)
          )
          (setq p (list x y z))
        )
        (foreach li lil
          (if
            (and
              (setq bp (cdr (assoc 10 (entget bl))))
              (setq lix (entget li))
              (< (distance bp (setq p1 (cdr (assoc 10 lix)))) (distance bp (setq p2 (cdr (assoc 11 lix)))))
            )
            (setq lst (cons (list bp p1 li p) lst))
            (setq lst (cons (list bp p2 li p) lst))
          )
        )
        (setq lst (vl-sort lst (function (lambda ( a b ) (< (distance (car a) (cadr a)) (distance (car b) (cadr b)))))))
        (setq lstt (append lstt (vl-remove-if-not (function (lambda ( x ) (equal (cadr x) (cadar lst) 1e-6))) lst)))
        (setq lst nil)
        (vla-move
          (vlax-ename->vla-object (cdr (assoc -1 (setq ex (entget bl)))))
          (vlax-3d-point (cdr (assoc 10 ex)))
          (vlax-3d-point p)
        )
      )
      (foreach d lstt
        (cond
          ( (equal (cadr d) (cdr (assoc 10 (setq lix (entget (caddr d))))) 1e-6)
            (entupd (cdr (assoc -1 (entmod (subst (cons 10 (cadddr d)) (assoc 10 lix) lix)))))
          )
          ( (equal (cadr d) (cdr (assoc 11 lix)) 1e-6)
            (entupd (cdr (assoc -1 (entmod (subst (cons 11 (cadddr d)) (assoc 11 lix) lix)))))
          )
        )
      )
    )
  )
  (princ)
)

(defun c:foo-remedy-attdata_lines+insert-positions ( / unique ftoa ss i e ex bll lil bp p1 p2 lix lst lstt )

  (defun unique ( l )
    (if l
      (cons
        (car l)
        (unique
          (vl-remove-if
            (function (lambda ( x )
              (eq (caddr x) (caddar l))
            ))
            (cdr l)
          )
        )
      )
    )
  )

  (defun ftoa ( n / m a s b )
    (if (numberp n)
      (progn
        (setq m (fix ((if (< n 0) - +) n 1e-8)))
        (setq a (abs (- n m)))
        (setq m (itoa m))
        (setq s "")
        (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
          (setq s (strcat s (itoa b)))
          (setq a (- (* a 10.0) b))
        )
        (if (= (type n) 'int)
          m
          (if (= s "")
            m
            (if (and (= m "0") (< n 0))
              (strcat "-" m "." s)
              (strcat m "." s)
            )
          )
        )
      )
    )
  )

  (if (setq ss (ssget "_:L" '((0 . "LINE,INSERT"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (if (= (cdr (assoc 0 (setq ex (entget e)))) "LINE")
          (setq lil (cons e lil))
          (if
            (and
              (assoc 66 ex)
              (equal (assoc 66 ex) (cons 66 1))
              (= (cdr (assoc 2 ex)) "DIAG_CROSS_4")
            )
            (setq bll (cons e bll))
          )
        )
      )
      (foreach bl bll
        (foreach li lil
          (if
            (and
              (setq bp (cdr (assoc 10 (entget bl))))
              (setq lix (entget li))
              (< (distance bp (setq p1 (cdr (assoc 10 lix)))) (distance bp (setq p2 (cdr (assoc 11 lix)))))
            )
            (setq lst (cons (list bp p1 bl) lst))
            (setq lst (cons (list bp p2 bl) lst))
          )
        )
        (setq lst (vl-sort lst (function (lambda ( a b ) (< (distance (car a) (cadr a)) (distance (car b) (cadr b)))))))
        (setq lstt (append lstt (vl-remove-if-not (function (lambda ( x ) (equal (cadr x) (cadar lst) 1e-6))) lst)))
        (setq lst nil)
      )
      (foreach d (unique lstt)
        (setq e (caddr d))
        (while (and e (setq e (entnext e)))
          (cond
            ( (= (cdr (assoc 2 (setq ex (entget e)))) "X")
              (entupd (cdr (assoc -1 (entmod (subst (cons 1 (ftoa (caadr d))) (assoc 1 ex) ex)))))
            )
            ( (= (cdr (assoc 2 (setq ex (entget e)))) "Y")
              (entupd (cdr (assoc -1 (entmod (subst (cons 1 (ftoa (cadadr d))) (assoc 1 ex) ex)))))
            )
            ( (= (cdr (assoc 2 (setq ex (entget e)))) "Z")
              (entupd (cdr (assoc -1 (entmod (subst (cons 1 (ftoa (caddr (cadr d)))) (assoc 1 ex) ex)))))
            )
            ( (= (cdr (assoc 0 (setq ex (entget e)))) "SEQEND")
              (setq e nil)
            )
          )
        )
      )
    )
  )
  (princ)
)

The codes are tested, but I think you could figure out if something's not as expected...

[raichu692003791074]

YEAH, SO IT'S A SQUIRLY ONE.....

The blocks are created using an import LISP. The X,Y,Z of the import co-ordinate from csv file are used to insert the block, then populate the attributes X,Y,Z of the block.

Once the blocks are inserted it can be required that the whole data set of survey points and lines have to be lifted or dropped to correspond with a reference height mark. So maybe the recorded information for the reference mark has a height +0.100m above the GPS co-ordinate for the same point observed by the surveyor in the field. They lift the whole survey dataset by +0.100, and the blocks X,Y,Z attributes retain the original import values.

They don't want to change the attribute X,Y,Z entries because it acts as a forensic trail for what manipulations have been applied to the survey. Not only the Z value may change, but the X,Y may change as the points are converted from one coordinate system to another.

Therefore the elevation of the DIAG_CROSS_4 block insertion point must be used not the attribute Z value.

I would totally do it another way round using different software, but this apparently is the way the surveyors are most comfortable with when using CAD vanilla, and they feel it's their best way to be able to track what's happened to the data after it's entered drafting/processing.

I'll check out your code when I get achance.

TY

[marko_ribar]

Well, look I've changed it little, but result is somewhat unexpected... But, you asked for it - the code is tested and work, but, but...

[BIG-AL]

Have you looked at some of the other products out there "Stringer" works with Bricscad and Autocad and should do what you want.

Start here https://civilsitedesign.au

[marko_ribar]

I've changed first code and it should work as desired...
Sorry for delay, but I had something else meanwhile in mind...

If I may notice, you have no feedback about codes... Suppose that if you had urge, you could figure out on your own - I gave you a gist for brainstorming...