get altitude between nearest pikets

Anonymous · ‎01-06-2015

hello again i am here with another question... how to automatically calculate PT (selected point) altitude triangle form between the nearest "pikets" in the database ?

this code using to put pikets in to the database (below). So using this code need calculate altitude. How to do this ?

(vl-load-com)
(defun c:blk-piketas ( / ent i lst ss)
  (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "Piketas"))))
    (progn
       (repeat (setq i (sslength ss))
	(setq ent (entget (ssname ss (setq i (1- i))))
	      lst (cons (cdr (assoc 5 ent))  lst)
	)
         )
      (vlax-ldata-put "ManoDirektorija" "Piketas" lst)
      (prompt (strcat "\n " (itoa (sslength ss)) " Piketas idetas i \"ManoDirektorija\" direktorija..."))
      )
    (prompt (strcat "\n \"Piketas\" nerastas..."))
    )
  (princ)
  )

Anonymous · ‎01-06-2015

It need to use

(While

(distance)

(getangle)

)

to scan objects fields and chech if there exist nearest three of them ? How to do that ?

i think it possible to modify the code i gave ^^

CADaSchtroumpf · ‎01-07-2015

It is it that you want?

(vl-load-com)
(defun c:blk-piketas ( / js_bl ent pt att lst_pt n X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 E1 E2 E3 E4 Z)
  (repeat 3
    (princ "\nSelect block 'PIKETAI'")
    (while (not (setq js_bl (ssget "_+.:E:S" '((0 . "INSERT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "PIKETAI") (100 . "AcDbBlockReference") (2 . "Piketas") (66 . 1))))))
    (setq ent (ssname js_bl 0))
    (setq pt (cdr (assoc 10 (entget ent))))
    (setq att (vlax-ename->vla-object ent))
    (mapcar
      '(lambda (val)
        (if (eq (vlax-get val 'TagString) "AUKSTIS")
          (setq pt (list (car pt) (cadr pt) (atof (vlax-get val 'TextString))))
        )
      )
      (vlax-invoke att 'GetAttributes)
    )
    (setq lst_pt (cons pt lst_pt))
  )
  (initget 9)
  (setq pt (getpoint "\nGive the point to interpolate: ") n 0)
  (foreach item '(("X" . "'car") ("Y" . "'cadr") ("Z" . "'caddr"))
    (mapcar '(lambda (x) (set (read (strcat (car item) (itoa (setq n (1+ n))))) x))
      (mapcar (eval (read (cdr item))) lst_pt)
    )
    (setq n 0)
  )
  (setq
    E1 (+ (* X1 (- Y2 Y3)) (* X2 (- Y3 Y1)) (* X3 (- Y1 Y2)))
    E2 (+ (* Y1 (- Z2 Z3)) (* Y2 (- Z3 Z1)) (* Y3 (- Z1 Z2)))
    E3 (+ (* Z1 (- X2 X3)) (* Z2 (- X3 X1)) (* Z3 (- X1 X2)))
    E4 (- (- (* E2 X1)) (* E3 Y1) (* E1 Z1))
    Z (- (- (* (/ E2 E1) (car pt))) (* (/ E3 E1) (cadr pt)) (/ E4 E1))
  )
  (command "_.point" "_none" (list (car pt) (cadr pt) Z))
  (print (rtos Z))
  (prin1)
)

Anonymous · ‎01-07-2015

emm yeah i mean that's what i looking for... its a giant code i see.. its imposible to do that do not need select block? but just it automaticaly search and should find;)

Kent1Cooper · ‎01-07-2015

@Anonymous wrote:

It need to ... scan objects fields and chech if there exist nearest three of them ? How to do that ?

...

I assume you want a routine to ask the User to select a location around which it will look for Blocks named "Piketas."

That could be done using (ssget "_C" ...) and constructing a small Crossing window around the selected location, or maybe better, (ssget "_F" ...) and constructing a polygonal Fence to approximate a circle, and if it doesn't find at least three such Blocks, constructing a larger Crossing window or Fence until it does find at least three. It would then need to check the XY distances between the selected location and the insertion points of the Blocks, limit it to the nearest three of them if it had found more than three, and then somehow calculate a weighted average between the Z coordinates of the insertion points.

Alternatively, it could just find all such Blocks [without the C or F selection] as your earlier code does, and check the distances of each from the selected location, keeping only the three closest ones. Whether that makes more sense may depend on how many such Blocks there are likely to be.

Does that sound like what you want to do?

Kent Cooper, AIA

stevor · ‎01-07-2015

My wild guess at your objectives:

1. find the 3 INSERTs that are the closest to each other.

2. do something with them by an 'altitude' thing.

My closest method is by the sum of the 3 distances;

which I tried to attach, and will try again.

S

stevor · ‎01-07-2015

The attachee: 'doesn't match its file type.'

So, hate to load the forum, yet:

; SS to Ent Name List AusCadd.com SS_LST
(defun SS_EnL (ss / L i ) (setq i 0 )
(repeat (if ss (ssLength ss) 0 ) ;to ist
   (setq L (cons (ssname ss i ) L ) i (1+ i)) ) (reverse L ) );ed

; return Ucs coords AusCadd.com
(DeFun Dxf_EU (gn edL / vv )
(if (and (setq vv (cdr (assoc gn edL)))
           (member gn (List 10 11 210 ))) ; others may exist!!!
    (trans vv (cdr (assoc -1 edL)) 1) vv ) )

; dxf associated data
(defun Dxf_ (N L) (cdr (assoc N L)) )

; cLosest 3 Inserts by sum of Legs
(defun c:bp3 ( / 3PL EnL1 EnL2 EnL3 DS SP1 SP2 SP3 D2 D13 D23 )
(if (setq ENL (SS_EnL (ssget "_X" '((0 . "INSERT") (2 . "Piketas")))))
    (progn (graphscr) (princ "\n Q: ")(prin1 (Length ENL ))
     (setq ENL1 ENL D3 1E16 )
     (whiLe (and ENL1 (setq EN1 (car ENL1 ) ))
      (setq SP1 (dxf_ 10 (entget EN1)) ENL1 (cdr ENL1) ENL2 ENL1 )
      (whiLe (and ENL2 (setq EN2 (car ENL2 ) ))
       (setq SP2 (dxf_ 10 (entget EN2)) ENL2 (cdr ENL2)
             ENL3 ENL2 D12 (distance SP1 SP2) )
       (whiLe (and ENL3 (setq EN3 (car ENL3 )))
        (setq SP3 (dxf_ 10 (entget EN3))
              D13 (distance SP1 SP3) D23 (distance SP2 SP3)
              DS (+ D12 D13 D23)      ENL3 (cdr ENL3) )
        (IF (< DS D3) (SETQ D3 DS 3DL (LIST EN1 EN2 EN3)))
       )
      ) ; (pP_"D3 ") (princ " Q1: ")(prin1 (Length ENL1))
     )
     (princ "\n 3 Leg dist: ")(prin1 D3 )
     (if gr_Xdc (foreach en 3dL (gr_xdc (dxf_eu 10 (entget en)) 1 1)))
     (setq 3pL (mapcar '(Lambda (n) (dxf_eu 10 (entget n)) ) 3dL ))
     ; as UCS GLOBAL Vars
     (setq IP1 (car 3pL) IP2 (cadr 3pL) IP3 (caddr 3pL) )
     (setvar 'cmdecho 0) (redraw) ; create LWPoLyLine on current
     (command "pLine")(foreach p 3pL (command p)) (command "c")
     (grdraw IP1 IP2 1)(grdraw IP3 IP2 1)(grdraw IP1 IP3 1)
     ;
    )
    (prompt (strcat "\n NO Pikers. "))
   ) (princ) )

(c:bp3) (princ " End ") (princ) )

S

Kent1Cooper · ‎01-07-2015

@stevor wrote:

The attachee: 'doesn't match its file type.'

So, hate to load the forum, yet:

....

If it was a .lsp file, that's a problem that a lot of people [myself included] have, though some people certainly can attach those [I think it may be affected by operating system and/or browser versions]. For future reference, put a .lsp file into a .zip file and you'll be able to attach that, or change its filetype ending to .txt or .doc or something, with a warning to others that you did so and that they should change it back after they download it [avoiding the need for that is why I use the .zip approach].

Kent Cooper, AIA

Kent1Cooper · ‎01-07-2015

@Anonymous wrote:

... how to automatically calculate PT (selected point) altitude triangle form between the nearest "pikets" in the database ....

That part is why I assumed what I did. But if I was right, here's a question:

If the selected point PT is somewhere within the triangle formed by the nearest three such Blocks, it shouldn't be difficult to calculate the elevation at that point on the plane of the triangle. But suppose the three Blocks nearest to PT are all off in generally the same direction from PT?

Block1 Block2

PT Block3

Block5 Block4

I would not assume that the location of PT on the extension of the plane of the triangle formed by those three nearest Blocks [Block2, Block3, Block4] would be a valid indication of the altitude at PT. Would it need to somehow find the three nearest Blocks that form a triangle that encloses PT ? In the above, presumably Block2, Block4 and Block5.

Kent Cooper, AIA

Anonymous · ‎01-07-2015

stevor wrote:

My wild guess at your objectives:

1. find the 3 INSERTs that are the closest to each other.

2. do something with them by an 'altitude' thing.

My closest method is by the sum of the 3 distances;

which I tried to attach, and will try again.

Actualy need to do this stuff witch is in lsp file i atached 😕 sorry about that

stevor · ‎01-07-2015

'doesn't match its file type.'
Believe that the .7z form was tried ,
same error.

S

Anonymous · ‎01-09-2015

Ok lets from begining, cause a little bit stuck in here ((: first of all i need to the code, which scans current object using getDist angle function in some perimeter automaticaly, or with entsel, can you help me with that ?

Kent1Cooper · ‎01-09-2015

@stevor wrote:
'doesn't match its file type.'
Believe that the .7z form was tried ,
same error.

[I don't know what .7z is about, but while I have had that problem trying to attach .lsp files, I have never had any problem attaching .zip files that contain .lsp files.]

Kent Cooper, AIA

CADaSchtroumpf · ‎01-09-2015

I tried to finish the previous code.
It tries to find 3 points so that the searched point is including in the triangle.

(vl-load-com)
(defun vect (p1 p2)
  (mapcar '- p2 p1)
)
(defun v^v (v1 v2)
  (list
    (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
    (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
    (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
  )
)
(defun pscal (v1 v2)
  (apply '+ (mapcar '* v1 v2))
)
(defun vlen (v)
  (distance '(0. 0. 0.) v)
)
(defun pt_include (p1 p2 p3 px /)
  (cond
    (
      (and
        (>= (pscal (v^v (vect p1 p2) (vect p1 px)) (v^v (vect p1 px) (vect p1 p3))) 0)
        (>= (pscal (v^v (vect p2 p1) (vect p2 px)) (v^v (vect p2 px) (vect p2 p3))) 0)
        (>= (pscal (v^v (vect p3 p1) (vect p3 px)) (v^v (vect p3 px) (vect p3 p2))) 0)
      )
      T
    )
    (T nil)
  )
)
(defun c:blk-piketas ( / ptc pix_size k js ptx n pt lst_tmp nw_lst nw_js nb ent att lst_pt X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 E1 E2 E3 E4 Z)
  (setq
    ptc (getvar "VIEWCTR")
    pix_size (getvar "SCREENSIZE")
    k (/ (getvar "VIEWSIZE") (cadr pix_size))
    pix_size (list (* (car pix_size) k 0.5) (* (getvar "VIEWSIZE") 0.5) 0.0)
    js (ssget "_C" (mapcar '- ptc pix_size) (mapcar '+ ptc pix_size) '((0 . "INSERT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "PIKETAI") (100 . "AcDbBlockReference") (2 . "Piketas") (66 . 1)))
  )
  (cond
    (js
      (initget 9)
      (while (setq ptx (getpoint "\nGive a point: "))
        (setq lst_tmp nil nw_lst nil)
        (repeat (setq n (sslength js))
          (setq
            pt (cdr (assoc 10 (entget (ssname js (setq n (1- n))))))
            lst_tmp (cons (cons(distance pt ptx) n) lst_tmp)
          )
        )
        (while (and (not (zerop (length lst_tmp))) (< (length nw_lst) 3))
          (setq
            nw_lst (cons (assoc (apply 'min (mapcar 'car lst_tmp)) lst_tmp) nw_lst)
            lst_tmp (vl-remove (assoc (apply 'min (mapcar 'car lst_tmp)) lst_tmp) lst_tmp)
          )
          (if (eq (length nw_lst) 3)
            (if
              (not
                (pt_include
                  (cdr (assoc 10 (entget (ssname js (cdar nw_lst)))))
                  (cdr (assoc 10 (entget (ssname js (cdadr nw_lst)))))
                  (cdr (assoc 10 (entget (ssname js (cdaddr nw_lst)))))
                  ptx
                )
              )
              (setq nw_lst (cdr nw_lst))
            )
          )
        )
        (cond
          ((and nw_lst (eq (length nw_lst) 3))
            (setq
              nw_js (ssadd)
              nw_js (ssadd (ssname js (cdar nw_lst)) nw_js)
              nw_js (ssadd (ssname js (cdadr nw_lst)) nw_js)
              nw_js (ssadd (ssname js (cdaddr nw_lst)) nw_js)
              nb 0
            )
            (sssetfirst nil nw_js)
            (repeat (setq n (sslength nw_js))
              (setq ent (ssname nw_js (setq n (1- n))))
              (setq pt (cdr (assoc 10 (entget ent))))
              (setq att (vlax-ename->vla-object ent))
              (mapcar
                '(lambda (val)
                  (if (eq (vlax-get val 'TagString) "AUKSTIS")
                    (setq pt (list (car pt) (cadr pt) (atof (vlax-get val 'TextString))))
                  )
                )
                (vlax-invoke att 'GetAttributes)
              )
              (setq lst_pt (cons pt lst_pt))
            )
            (foreach item '(("X" . "'car") ("Y" . "'cadr") ("Z" . "'caddr"))
              (mapcar '(lambda (x) (set (read (strcat (car item) (itoa (setq nb (1+ nb))))) x))
                (mapcar (eval (read (cdr item))) lst_pt)
              )
              (setq nb 0)
            )
            (setq
              E1 (+ (* X1 (- Y2 Y3)) (* X2 (- Y3 Y1)) (* X3 (- Y1 Y2)))
              E2 (+ (* Y1 (- Z2 Z3)) (* Y2 (- Z3 Z1)) (* Y3 (- Z1 Z2)))
              E3 (+ (* Z1 (- X2 X3)) (* Z2 (- X3 X1)) (* Z3 (- X1 X2)))
              E4 (- (- (* E2 X1)) (* E3 Y1) (* E1 Z1))
              Z (- (- (* (/ E2 E1) (car pt))) (* (/ E3 E1) (cadr pt)) (/ E4 E1))
            )
            (entmake (list '(0 . "POINT") (assoc 67 (entget ent)) (assoc 410 (entget ent)) (cons 8 (getvar "CLAYER")) (cons 10 (list (car ptx) (cadr ptx) Z)) '(210 0.0 0.0 1.0)))
            (print Z)
          )
          (T (princ "\nNot enough points found!"))
        )
        (initget 8)
      )
      (sssetfirst nil nil)
    )
  )
  (prin1)
)

CADaSchtroumpf · ‎01-09-2015

Oops, please change:
Z (- (- (* (/ E2 E1) (car pt))) (* (/ E3 E1) (cadr pt)) (/ E4 E1))
to
Z (- (- (* (/ E2 E1) (car ptx))) (* (/ E3 E1) (cadr ptx)) (/ E4 E1))

Anonymous · ‎01-10-2015

Thank you what is dat number when it found those nearest object ? It shows 15,7954

CADaSchtroumpf · ‎01-10-2015

[quote]Thank you what is dat number when it found those nearest object ? It shows 15,7954[/quote]
It's the z calculated to the most near points AND included in triangle

Community

get altitude between nearest pikets

get altitude between nearest pikets

get altitude between nearest pikets