Topic: Triangulation (re-visited)

[d.valkanov]

I will write this one in Lisp

[ymg]

d.valkanov,

Now bear with me, I am somewhat challenged with C code.

The last one as far as I can tell remove triangle either inside or
outside depending on the calling parameter InOut.

Seems to be OK for me.

But what I am saying in the previous post is about determining
in the set of closed breaklines which one are holes and which one
is the outside boundary.

In other word the user simply creates breaklines.

When the program runs, If is a closed breakline with no point in
it knows it must clean the inside.

If the closed breakline contains all the point, any triangle outside
gets cleaned.

ymg

[rw2691]

YMG,

Yes, your depression code has several sections changed in it from mine.

I have version Triang V0.6.7.

Is there a later version?

Rick

[ymg]

Rick,

Not published yet, except for  little snips in the thread.

Will publish once I have the even contour settled
hopefully.  As of now it looks good.

ymg

[rw2691]

YMG,

I found the error in Profile... at around line 3919 (I have done some formatting and comments that change your line numbers) there is...

Code: [Select]

(setq temp (list (list (car disl) (caar entl))))
       
   (setq entl (mapcar '(lambda (a)
                                   (setq i -1)
                           (while (< (caddr (nth (setq i (1+ i)) entl)) a))
                                   (list a (car (nth (1- i) entl)))
                               )
                       (cdr disl)
                           )
         )
   (setq entl (append temp entl))      ;;;;   temp -was- tmp ... tmp is a typo

Changing TMP to TEMP causes the function to include the 0+00 station in the profile.

Then at around line 3939...

Code: [Select]

;; Var prof now contains the list of the profile sorted.           ;
   
           (setq chal (mapcar '(lambda (a) (rtosta (+ chbeg (car  a)) 1 prec)) prof) ;; 1 prec -was- 2 prec

It might be only a preference, but using "1" instead of "2" changes the station format from 0+180 to 1+80, as in 180'. 0+180 might be valid for somewhere, but I have never seen it before. Perhaps there should be an option for choosing the preferred format.

[rw2691]

YMG,

After posting I remembered another item. I think it would be good to include break stations to the grade. As is, high and low points are ignored, and intermediate changes by ditches are absent. With break stations, critical slopes can also be better evaluated.

Rick

[ymg]

Rick,

Sorry about late reply, I am travelling so not doing much
on the program.

I will certainly consider your suggestions.

ymg

[rw2691]

YMG,

I don't think that the break stations (at the TIN breaks) need to be marked on the grid... only included in the profile line. There could be many breaks, and that would clutter the grid. But if they are drawn on the profile line, the user can snap and draw to the grid to manually have the station and elevation of anything important.

Another option for automation would be to have a routine for snapping to the profile line, and have it report its station and elevation. You could also include a print option, where you click yes/no, and it could draw the notation for Sta & Elv with a drag line to the snapped position as a leader. It would keep the user from having to calculate the elevation by the vertical scaling.

If you want... I have a similar routine that I have made for Horizontal Sta & Ofs. It could be easily modified to make the Sta & Elv function.

Rick

[rw2691]

YMG,

I managed to modify the PROF code so it draws the slope line breaking at each edge of the TIN, and it still grids the stations at selected intervals (ie. 20' or 40').

What I did, however, is a hack and probably very ugly coding. Nevertheless, if you want it I can post it.

Rick

[ymg]

Rick,

Post it I'll take a look at it.

But as I told you, I am not working on it at the moment.

ymg

[rw2691]

YMG,

The following is a patch to draw profile lines by TIN breaks while also drawing increment stations by assigned intervals.

The following is to declare local variables that are new...

Code: [Select]

(defun c:prof (/ *acdoc* *acspc* *hinc* *en* *entl* pstart pclose
                cntz ofsy ydatum x1 x2 y1 y2 z1 z2 g1 g2)

Then adding assignments for *en* and *entl* at an early section of the PROF code,

  (setq entl (getproftin en)
          prof (distinctfuzz

was modified to be...

Code: [Select]

;;>>>>>> begin patch by RLW
 (setq  *en* en     
      *entl* (getproftin en)
        entl (getproftin en)
        prof (distinctfuzz
;;>>>>>> end patch by RLW

Then later at...   

Code: [Select]

(if (= opt 1)
      (progn
;;>>>>>>>>>>>>>>>>>>>>>> begin RLW patch
        ;; now updating *hinc* and reassigning hinc, en, and entl           
       (setq *hinc* hinc hinc 0 en *en* entl *entl*)  ;; setup to fool the product   
                 
   (setq disl (mapcar '(lambda (a) (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en a))) pol))
       (if (> hinc 0) ; We have a profile at selected interval  ie hrz increment          ;
       (setq dist (- hinc (rem chbeg hinc))
             disl (vl-sort (append disl (in_range dist dtot hinc)) '<)
             )
       ; Else Points Every of Intersection 3dfaces   ie at every break in TIN   ;
       (setq disl (vl-sort (distinct (append disl (mapcar 'caddr entl))) '<))
       )
           
   (setq temp (list (list (car disl) (caar entl))))
       
   (setq entl (mapcar '(lambda (a)
                                   (setq i -1)
                           (while (< (caddr (nth (setq i (1+ i)) entl)) a))
                                   (list a (car (nth (1- i) entl)))
                               )
                       (cdr disl)
                           )
         )
   (setq entl (append temp entl)) ;; temp -was- tmp ...I think tmp is a typo
       
   (setq prof0 (mapcar '(lambda (a)
                               (setq  p (vlax-curve-getPointAtDist en (car a))
                 ps (get_3dfpts (cadr a))
                     )     
               (list (car a) (caddr (getz p (car ps) (cadr ps) (caddr ps))))
                             )
               entl
                   )
         )
             
   (if copyen  ;  If we had a 3dpoly, erase the temporary entity.     ;
       (setq ** (entdel en)
         en copyen copyen nil
             )
       ) 
;;>>>>>>>>>>>>>>>>>>>>>> 
;; now redoing the above with new assignments...
;;>>>>>>>>>>>>>>>>>>>>>>
;; reassigning hinc, en, and entl
       (setq hinc *hinc* en *en* entl *entl*)
       
   (setq disl (mapcar '(lambda (a) (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en a))) pol))
       (if (> hinc 0) ; We have a profile at selected interval  ie hrz increment          ;
       (setq dist (- hinc (rem chbeg hinc))
             disl (vl-sort (append disl (in_range dist dtot hinc)) '<)
             )
       ; Else Points Every of Intersection 3dfaces   ie at every break in TIN   ;
       (setq disl (vl-sort (distinct (append disl (mapcar 'caddr entl))) '<))
       )
         
   (setq temp (list (list (car disl) (caar entl))))
       
   (setq entl (mapcar '(lambda (a)
                                   (setq i -1)
                           (while (< (caddr (nth (setq i (1+ i)) entl)) a))
                                   (list a (car (nth (1- i) entl)))
                               )
                       (cdr disl)
                           )
         )
   (setq entl (append temp entl)) ;; temp -was- tmp ...I think tmp is a typo
       
   (setq prof (mapcar '(lambda (a)
                               (setq  p (vlax-curve-getPointAtDist en (car a))
                 ps (get_3dfpts (cadr a))
                     )     
               (list (car a) (caddr (getz p (car ps) (cadr ps) (caddr ps))))
                             )
               entl
                   )
         )
             
   (if copyen  ;  If we had a 3dpoly, erase the temporary entity.     ;
       (setq ** (entdel en)
         en copyen copyen nil
             )
       ) 
;;>>>>>>>>>>>>>>>>>>>>>> close RLW patch
       
           ;; Var prof now contains the list of the profile sorted.           ; 
           (setq chal (mapcar '(lambda (a) (rtosta (+ chbeg (car  a)) 1 prec)) prof) ;; 1 IMPERIAL, 2 METRIC
         elvl (mapcar '(lambda (a) (rtos (cadr a) 2 prec)) prof)

Then at the bottom, and just above where it says, "Moving the profile where we want it"
I added the following for drawing and labeling horizontal grid lines for the Profile.

Code: [Select]

           
           (mk_layer (list "Profile Grid" gridcolor))
           (foreach p prof
              (ssadd (entmakex (list '(0 . "LINE") (cons 10 (list (car p) ylinc)) (cons 11 (list (car p) yline)))) ssp)
              (ssadd (entmakex (list '(0 . "LINE") (cons 10 (list (car p) yline)) (cons 11 p))) ssp)
          )
             
;;>>>>>>>> start patch by RLW
           ;; draw horizontal grid and label their elevations
           (setq pstart (car prof) pclose (last prof) cntz zmin)
           (setq ydatum (- (cadr pstart) (* vexag (- (atof (car elvl)) zmin))))     
           (while (< cntz zmax)
                  (setq cntz (+ cntz vinc))
                  (setq ofsy (* (- cntz zmin) vexag))
                  (setq x1 (car pstart)
                        y1 (+ ydatum ofsy)
                        z1 0                       
                        x2 (car pclose)
                        y2 y1
                        z2 0                       
                        g1 (list x1 y1 z1)
                        g2 (list x2 y2 z2)
                        )
                  (ssadd (entmakex (list '(0 . "LINE") (cons 10 g1) (cons 11 g2))) ssp)
                  (ssadd (mk_mtext (polar g1 pi txth) (rtos cntz 2 2) 6 txth 0) ssp)
                  )
           (ssadd (entmakex (list '(0 . "LINE") (cons 10 g1) (cons 11 pstart))) ssp)   ;; recent addition
           (ssadd (entmakex (list '(0 . "LINE") (cons 10 g2) (cons 11 pclose))) ssp)   ;; recent addition
             
           ;; delete the grid data profile line
           (vl-cmdf "._erase" ssx "")
;;>>>>>>> end patch by RLW

           ;; Moving the profile where we want it.                             ;
           (vl-cmdf "._MOVE" ssp "" org pause)
          

I have had to add some provisions that make it conform to your code. So if it doesn't work, let me know. It all works very well at my end. The horizontal grid lines at the bottom are recent. They need a some dressing up to look professional, but they do utilize the vinc variable and are nearly there.

Note: Just made a recent addition at the bottom of building the horizontal grid lines.
          I also changed (while (<= cntz zmax) to (while (< cntz zmax) so that the hrz grid
          will stop at zmax.
           
Rick

[rw2691]

YMG,

I believe I may have found a problem with the REMDUPPOINT function. Since it is using BUTLAST to create a 2d point, it returns a horizontal distance instead of a slope distance.

Nevertheless, if two points were the bottom and top of a wall, it is possible that only the z value would separate them, and having the same xy values would be valid for a TIN... but REMDUPPOINT is deleting one of the points from the list.

Rick

[rw2691]

YMG,

Consider the following to allow for elevation separation of equal 2d points...

Code: [Select]

;; remduppoint       by Joe Burke                                             ;
;; Remove Duplicate Adjacent Points from Point List with Fuzz Factor          ;
;; Point List Needs to be Sorted Prior to Calling this Function               ;
;; Modified by YMG to operate on 2d points... (butlast p)                     ;
(defun remduppoint (l fuzz / rtn p)
   (repeat (1- (length l))
           (setq p (car l))
           (if (> (distance (butlast p) (cadr l)) fuzz) ;; butlast for 2d
                   (setq rtn (cons p rtn))
                   (if (> (distance p (cadr l)) (* 2 fuzz)) ;; 3d & double fuzz
                       (setq rtn (cons p rtn))
                       )
                   )
               )
           (setq l (cdr l))
           )
   (reverse (cons (car l) rtn))
)

But if you do this you might also want to consider a sortxyz function, since the next z needs to be the nearest z...

Code: [Select]

(defun sortxyz (a / b c e1 e2)  ;;  a: list of points
       (setq b (vl-sort a (function (lambda (e1 e2) (< (caddr e1) (caddr e2)) ) )))  ;; by z
       (setq c (vl-sort b (function (lambda (e1 e2) (< (cadr e1) (cadr e2)) ) )))  ;; by y
       (setq a (vl-sort c (function (lambda (e1 e2) (< (car e1) (car e2)) ) )))  ;; by x             
       )

The above sortxyz was found and herewith modified from an anonymous forum example.

Note: I have edited my posting for REMDUPPOINT. I placed the code in the wrong place. I hope this fixes it.

[squirreldip]

I've been following this thread for quite some time and amazed by the progress and usefulness if this tool.

An improvement for me would be that Triangulation be broken down into separate functions that can be utilized/called within new routines.  For example, I would like to return the elevation at a given point...

I've attached a rework of the latest Triangulation and divided/added the following routines:

(TIN:GETPOINTSLIST <entset>) ;; Returns a list of points

Code: [Select]

(setq PLIST (TIN:GETPOINTSLIST (ssget)))
(TIN:GETBREAKLINELIST <entset>) ;; Returns a list of point pairs

Code: [Select]

(setq BLIST (TIN:GETBREAKLINELIST (ssget)))
(TIN:TRIANGULATE <plist> <blist>) ;; Returns a list of triangles

Code: [Select]

(setq TLIST (TIN:TRIANGULATE PLIST BLIST))
(TIN:DRAW <tlist>) ;; Creates an anonymous block on the current layer with the 3DFace triangles

Code: [Select]

(TIN:DRAW TLIST)
(TIN:GET <ent>) ;; Returns the list of triangles for the selected block drawn by TIN:DRAW

Code: [Select]

(setq TLIST (TIN:GET (car (entsel)))
(TIN:READ <filename>) ;; Returns the list of triangles as read from the file name provided

Code: [Select]

(setq TLIST (TIN:READ FILENAME))
(TIN:WRITE <filename> <tlist>) ;; Writes the triangle list to file name provided

Code: [Select]

(TIN:WRITE FILENAME TLIST)
(TIN:ELEVATIONATPOINT <point> <tlist>) ;; Returns the elevation of the point on the provided triangles

Code: [Select]

(setq Z (TIN:ELEVATIONATPOINT (getpoint) TLIST)

The last was a bit of a brute force to try to get what my thoughts are.  I've tried to keep all variables local.  There is so much time spent on this and so I'm sure this can be improved on.

Next steps would be to define a routine to return a section between two points, generate contours, include some of the other features that have been included in the original (such as boundaries).

If I'm way off base with what I've done here please let me know - if anyone agrees with this direction please also comment.


Edit - Link to updated file:
https://www.theswamp.org/index.php?topic=9042.msg564291#msg564291
(fixed issue reported/solved by rw2691)

[rw2691]

squirreldip,

I like the idea of getting an elevation at any position within the TIN.

I also like having utility functions that can be used for longer ranged goals.

Rick