Author Topic: Triangulation (re-visited)  (Read 312804 times)

0 Members and 1 Guest are viewing this topic.

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #645 on: May 06, 2016, 10:17:57 AM »
Quote
I just tried it with a 2D LWpolyline and it did not work because it refused the poly as a selection.

There was a bug at (ssdel en) should be (ssdel en ss)

I corrected in the above and removed the orphan.

OCD remains an option as a standalone routine to clean
your final presentation.
« Last Edit: May 06, 2016, 10:23:02 AM by ymg »

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #646 on: May 06, 2016, 11:48:43 AM »
YMG,

I don't see where FLT is being set. The only place that I find is an indirect assignment by "getfencesel", but the only place it is called by is "getproftin" for PROF.

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #647 on: May 06, 2016, 12:39:20 PM »
YMG,

I took the liberty of assigning the FLT variable... (setq flt '((0 . "POINT,INSERT,*LINE")))

Then I reactivated your section of code that AUGI:OCD had replaced in C:TIN.

It worked flawlessly. The TIN was built internally to the boundary, and all exterior TIN's were removed.

I created contours by the same and it drew them properly.

I won't have to use the OCD code, but implementing it had taught me lot about LISP and your Triangles program.

Your new code that selects by the Boundary has made the entire system more flexible. You can load a drawing that already has the points and boundary, and build the TIN. Frequently work sessions get interrupted. This allows a user to exit and resume without any loss to what he had already done.

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #648 on: May 06, 2016, 01:45:22 PM »
Rick,

I should have incluse these 2 lines in the snippet.

Code - Auto/Visual Lisp: [Select]
  1. (setq  ss nil ssb nil ssw nil
  2.       flt '((0 . "POINT,INSERT,LWPOLYLINE,POLYLINE,LINE"))
  3. )
  4.  

Note that I removed the *line from the filter as there was a
slim possibility to select "MLINE" which are not handled.

ymg

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #649 on: May 06, 2016, 03:26:36 PM »
YMG,

ssw, though it is initialized in version 0.6.7.0, is never used.

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #650 on: May 08, 2016, 09:03:02 AM »
YMG,

In "defun contour", and at the "foreach p xl" section, you have...
(setq isclosed nil code 0)

I think you want it to be...
(setq isclosed nil code 128)

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #651 on: May 12, 2016, 09:30:27 AM »
YMG,

I found this mistake in your TIN patch...

                (progn
                      (vl-cmdf "_ZOOM" "_O" en)
                      (setq pol (listpol en)                  ;; was... ***  (setq pol (distinct (listpol en)) ***
                               ss (ssget "_CP" pol flt)
                               )
                      (vl-cmdf "_ZOOM" "_P")

The 3rd line should not use the DISTINCT function. It eliminates the closing points, and results with TIN's contiguous to the closing point being erased. The above code is modified to remove DISTINCT.

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #652 on: May 12, 2016, 09:33:43 AM »
To all,

Can anyone explain to me how an INSERT might be used as a BREAK-LINE?

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #653 on: May 12, 2016, 09:36:05 AM »
To all,

Can anyone tell me what the MAKEREADABLE function is doing?

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #654 on: May 12, 2016, 12:25:36 PM »
To all,

Can anyone tell me what the MAKEREADABLE function is doing?

Rick

Without checking, so I may be wrong, but IMO this sub function is intended to place text objects rotation to be the most acceptable for reading that text object...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #655 on: May 12, 2016, 03:17:35 PM »
ribarm,

That's what I had assumed. It isn't working with ViewTwist activated.

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #656 on: May 12, 2016, 04:20:43 PM »
YMG,

MakeReadable has a problem with ViewTwist. I use ViewTwist to fit a drawing on to paper. Your routine is elegant ... and so much so, that I can't follow it. You may have trouble with my code as well. It is gritty. Nevertheless, it handles the upright scenario with or without ViewTwist being active...

Code: [Select]
(defun rw-SetTxtUpright (setazm / azmref ucsaxis azmaxs) ;; sets bearing to upright by "twist" perspective
       (if (< setazm 0)
           (setq azmref (+ setazm (* pi 2))) ; pi radians = 180 deg
           (setq azmref setazm)
           )
       (if (> azmref (* pi 2)) ; 360 deg
           (setq azmref (- azmref (* pi 2)))
           )
       (setq ucsaxs (getvar "viewtwist"))
       (if (< ucsaxs 0)
           (setq azmaxs (+ ucsaxs (* pi 2)))
           (setq azmaxs ucsaxs)
           )
       (if (> azmaxs (* pi 2))
           (setq azmaxs (- azmaxs (* pi 2)))
           )
       (setq azmref (+ azmref azmaxs)) ; rotate ref by axs
       (if (> azmref (* pi 2))
           (setq azmref (- azmref (* pi 2)))
           )
       (if (and (> azmref (/ pi 2)) ; 90 deg
                (< azmref (* (/ pi 2) 3)) ; 270 deg
                )
           (+ setazm pi) ;; report bearing righted
           setazm ;; report bearing normal
           )
       )

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #657 on: May 12, 2016, 04:39:27 PM »
YMG,

I have written code for labeling contours by simply picking a point on the contour and writing its elevation at that spot. Drag-Lines are cool, but I rarely have an occasion where they are applicable. I am always having to dodge other data and objects on the drawing.

The following is a rework to your mk_mtext. I have simply added masking to it for my application.

Code: [Select]
;; mk_mtext  by ymg  *** modified as mk_masked_text by rw2691 for masking *** ;
;; Arguments: p,  Insertion Point.                                            ;
;;            s,  Text.                                                       ;
;;            j,  Justification:                                              ;
;;                1 = Top left; 2 = Top center; 3 = Top right;                ;
;;                4 = Middle left; 5 = Middle center; 6 = Middle right;       ;
;;                7 = Bottom left; 8 = Bottom center; 9 = Bottom right        ;
;;            h,  Text Height.                                                ;
;;            r,  Rotation.                                                   ;
;;            c,  text color                                                  ;
;;            ms,  mask state ...1=on 2=off                                   ;
;;            mc,  mask color ...1, 7, or 254 slight-gray or ash                       ;
;;            mr,  mask ratio ...typical is 1.4                               ;
;; Limitation: 255 character string for text
(defun mk_masked_text (p s j h r c ms mc mr)
   (if (= ms nil) (setq ms 2 mc 1 mr 1.4))
   (entmakex
      (list (cons 0   "MTEXT")         
            (cons 100 "AcDbEntity")         
            (cons 100 "AcDbMText")   
            (cons 10 p) ;; point
            (cons 71 j) ;; justify
            (cons 40 h) ;; height         
            (cons 50 r) ;; rotate by radians 0=right pi=left
            (cons  1 s) ;; string
            (cons 62 c) ;; color 256=bylayer 0=byblock negative=layeroff           
            (cons 90 ms) ;; mask state ;; 1 is mask-on ... 2 is mask-off
            (cons 63 mc) ;; mask color ;; 1 is red, 7 white, 254 ash, etc.
            (cons 45 mr) ;; mask ratio ;; 1.0 is text height, 1.4 is 0.4 larger than text height
      )
   )
)

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #658 on: May 12, 2016, 05:13:20 PM »
YMG,

This is my labeling code. It uses the mk_masked_text that I posted, and the rw-SetTxtUpright as well. It has an advantage in that it will work with splines as well as all the other lines and poly's. I devised a mechanical method for finding the bearing at any position along any line type.

Code: [Select]
(defun c:lbl () ;; utility command name that can be changed
       (rw-cmdlbl)
       )

; Label contour line. Works with line, polyline, lwpolyline, 2d & 3d polyline, spline and point.
(defun rw-cmdlbl (/ en0 en1 en2 azm pnt snp i dst str1 elv) 
       (setq j 0)
       (mk_layer (list ".SRF-LBL" 1)) ;; this differs from the standard layer scheme... it can be changed
       (while (= j 0) ; 1st while
             (setq i 0)
             (while (= i 0) ; 2nd while
                     (setq oldsnap (getvar "osmode") en0 nil en1 nil en2 nil)
                     (setvar "osmode" 512)
                     (setq pnt (getpoint "\nSelect contour at label position (snap-nearest active)... "))
                     (setvar "osmode" oldsnap)
                     (if pnt (setq en0 (osnap pnt "near")))
                     (if en0 (setq en1 (car (nentselp en0))))
                     (if en1 (progn (setq ed (entget en1))
                                    (setq et (cdr (assoc 0 ed)))
                                    (if (= et "POLYLINE") (setq i 1))
                                    (if (= et "LWPOLYLINE") (setq i 2))
                                    (if (= et "2DPOLYLINE") (setq i 1))
                                    (if (= et "3DPOLYLINE") (setq i 1))
                                    (if (= et "SPLINE") (setq i 1))
                                    (if (= et "LINE") (setq i 1))
                                    (if (= et "POINT") (setq i 1))
                                    ) ;p
                             (progn (setq rsp (getstring "\nWarning - No contour found...  exit?  Y/N <Y>: "))
                                    (if (= rsp "") (setq rsp "Y"))
                                    (setq rsp (strcase rsp))
                                    (if (= rsp "Y") (setq i 9 j 9 et "EXIT")) ; i 0 was i 9
                                    ) ;p
                             ) ;i
                     (if (= i 1) (setq elv (cadddr (assoc 10 ed))))
                     (if (= i 2) (setq elv (cdr (assoc 38 ed))))
                     (if (and (= elv 0)(> i 0))
                         (progn (setq drw (getstring "\nWarning -- Contour is 0... Label? Y/N <Y>: "))
                                (if (/= drw "") (setq drw (strcase drw)))
                                (if (/= drw "N") (setq i 1) (setq i 0))
                                )
                         )
                      ) ; end 2nd while
              (if (and (< i 9) (< j 9)) ; was (and (> i 0) (< i 9))
                  (progn (setq txtscale (* (getvar "ltscale") 0.06)) ;; 0.06 hight for red's printing width
                         (setq str1 (rtos elv 2 0)) ;; 0 is precision, ie. 0, 1 or 2... etc.
                         
                         ;>>>>>=====================================================
                         ;; start process for aquiring bearing of line at snap-point
                         (setq dst (strlen str1))
                         (setq dst (/ (* dst txtscale) 200))
                         
                         (command "circle" pnt dst)
                         (setq en2 (entlast))
                                                 
                         (setq snp (osnap pnt "_app"))  ;; "_end,_int" to combine snaps for other applications
                         ;; note: it doesn't matter which INT it snaps, rw-SetTxtUpright will correct its display                         
                         (setq azm (rw-SetTxtUpright (angle pnt snp)))  ;; alternate: (setq azm (makereadable (angle pnt snp)))
                         (entdel en2)
                         ;; close process for aquiring bearing of line at snap-point
                         ;>>>>>=====================================================
                         
                         ;; (mk_masked_text point string justify height rotation color mask-state mask-color mask-ratio)
                         (mk_masked_text pnt str1 5 txtscale azm 1 1 254 1.4)
                         ) ;p
                  ) ;i
              ) ; end 1st while
       (princ)
       ) ;; end rw-cmdlbl

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #659 on: May 12, 2016, 05:29:41 PM »
YMG,

This is an entmake for spirals... upon building contours, I additionally build a spiral from your adjusted curves, and I place them in a private layer. I do it by placing the following code at the end of the foreeach section of "defun contours"

       (setq LastLyr (getvar "CLAYER"))
       (mk_layer (list ".SRF-FIN" 7))
       (Make_Spline lp z)
       (setvar "CLAYER" LastLyr)

Afterward I can compare them and tweak the spirals where they have been too liberal. They have problems where a contour has not been rounded because it turns nearly 90 degrees to the path. The spiral swings out to smooth the turn. Yet it is easy to notice and correct by dragging nodes.

It is also something that could be fixed by placing in and out nodes to force the sharp turn. The spiral would follow that condition.

Code: [Select]
(defun Make_Spline (lst-pts z / p px py pt data closed)
      ;; Author: R. Togores (togoresr@unican.es)
      ;; Modified: R. Wills (rick.wills@mapmakers.biz)
      ;; drawing layer, lisp point-list, contour-elevation or nil
      ;; point-list can be 2d or 3d, open or closed, contour or radical
      ;; if z is specified (not nil) it creates 3d spline with uniform elevation
     
      (setq closed nil closed (equal (car lst-pts ) (last lst-pts ) 0.005)) ;; set closed or open
     
      (if z (progn
               (setq data nil)
               (foreach p lst-pts
                   (setq pt (list (car p) (cadr p) z)) ;; build contour elevation
                   (setq data (append data (list pt)))
                   ) ;f
               (setq lst-pts data)                   
               ) ;p
            ) ;i
           
      (entmake (append (list '(0 . "SPLINE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbSpline")
                             '(44 . 1.0e-005)
                              (cons 48 0.75) ;;  celtscale... pattern scaler
                              (cons 71 (if closed    ;; bitwise 1=closed
                                           11        ;;         2=periodic; default for closed [hence 11]
                                           8         ;;         4=rational
                                           ) ;i      ;;         8=planar; default for closed [hence 11]
                                    ) ;c             ;;         16=linear
                              '(70 . 1)  ;; degree of spline: number of control-points + 1, ie. 1 is none
                              (cons 74 (if closed
                                           (1+ (length lst-pts )) ;; number of fit-points
                                           (length lst-pts )
                                           ) ;i
                                    ) ;c
                              ) ;l
                       (if closed (cons (cons 11 (last lst-pts ))
                                        (mapcar '(lambda (x) (cons 11 x)) lst-pts)  ;; closed fit-points
                                        ) ;c
                                  (mapcar '(lambda (x) (cons 11 x)) lst-pts)  ;; open fit-points
                           ) ;i
                       ) ;a
              ) ;e
       ) ;m

Rick
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."