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

0 Members and 1 Guest are viewing this topic.

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #660 on: May 15, 2016, 04:50:17 AM »
Rick,

Thanks ! for your contribution. 

The makereadable is indeed to keep text oriented in a readable manner,
and it does not take into account twisted view.

For the labeling, there is already 3 different way in the program:
       dlbl   -  For dynamic labeling with drag line
       flbl    -  Same as above but not dynamic
        lbl    -  Put label at a given spacing on contours.

The one you are proposing would help in completing the suite.
Incidentally they all use text mask.

However the whole program needs a revision for twist angle and /or UCS.

For Splines in Contour, I tend to stay away and do not plan to integrate any.

In closing here maybe a little better for readable text orientation.
Instead of using rem to normalize the angle we use  (atan (sin a) (cos a))
which gives an angle between -pi and pi.  Also notes that I test on 10 degrees
past the 90 to mimic the Express tool behaviour.

Need to be tested.

Code - Auto/Visual Lisp: [Select]
  1. (defun torient (a)
  2.    (setq a (atan (sin a) (cos a)))
  3.    (if (minusp a)
  4.       (if (< a -1.5708) (+ a pi) a)
  5.       (if (> a  1.7453) (+ a pi) a)      
  6.    )
  7. )
  8.  

Yet another one for direction of polyline less sensitive to
roundoff, and a little faster than what I had.

Code - Auto/Visual Lisp: [Select]
  1. ;;                                                                             ;
  2. ;; iscw_p         by ymg     (From a Routine in C++ by Dan Sunday)             ;
  3. ;;                                                                             ;
  4. ;; Predicate to Test the Orientation of a Simple Closed Polyline               ;
  5. ;;                                                                             ;
  6. ;;  Argument:  l -  List of Points (Opt. First Point Repeats at End of list)   ;
  7. ;;                                                                             ;
  8. ;;  Return:    t -  Polyline is clockwise                                      ;
  9. ;;           nil -  Polyline is counterclockwise or Degenerate (< (length l) 3);
  10. ;;                                                                             ;
  11. ;;  Note:     This algorithm is about 20% faster than computing                ;
  12. ;;            the signed area and is less subject to rounding error            ;
  13. ;;            when using large coordinates.                                    ;
  14. ;;                                                                             ;
  15.  
  16. (defun iscw_p (l / x0 y0 x1 y1 pos i p0 p2)
  17.    
  18.    (or (equal (car l) (last l)) (setq l (cons (last l) l)))
  19.    
  20.    (setq y1 1.7e308  i 0)
  21.    (mapcar
  22.       (function
  23.          (lambda (p)
  24.             (cond
  25.                ((> (cadr p) y1))
  26.                ((and (= (cadr p) y1) (<= (car p) x1)))
  27.                (t (setq pos i x1 (car p) y1 (cadr p)))
  28.             )
  29.             (setq i (1+ i))
  30.          )
  31.       )
  32.       l
  33.    )
  34.    
  35.    (if (zerop pos)
  36.       (setq p0 (cadr (reverse l))
  37.             x0 (car p0)  y0 (cadr p0)  p2 (cadr l)
  38.       )
  39.       (setq p0 (nth (1- pos) l)
  40.             x0 (car p0)  y0 (cadr p0)  p2 (nth (1+ pos) l)
  41.       )
  42.    )    
  43.    (< (* (- x1 x0) (- (cadr p2) y0)) (* (- (car p2) x0) (- y1 y0)))
  44. )
  45.  






rw2691

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

Quote
For the labeling, there is already 3 different way in the program:
       dlbl   -  For dynamic labeling with drag line
       flbl    -  Same as above but not dynamic
        lbl    -  Put label at a given spacing on contours.

The one you are proposing would help in completing the suite.
Incidentally they all use text mask.

I created the mk_masked_text function because their method for activating the background color was temperamental. It worked once and then quit. I couldn't track down what was wrong. That is one of the things that I don't like about VLAX routines. Using your mk_mtext and modifying it was very direct. It always works.

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

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #662 on: May 17, 2016, 08:47:43 AM »
YMG,

I patched in torient and renamed it to MakeReadable. It functioned the same as the former MakeReadable had done. No loss to function.

I patched in iscw_p and hid the former iscw_p. It functioned well.

As to other things. I looked at the masking in FLBL. Its VLAX coloring is less than its actual mask, and the coloring is also offset slightly toward the right of the text. I compared this with the MK_MASKED_TEXT function and its mask and coloring match each other, and they are uniform (not offset) to the text body. I think its behavior is better than the VLAX code.

In looking for clockwise and counter behavior, I got things wrong at some point, thinking that your BOUND routine had to be constructed in a clockwise direction. So I drew it counterwise to make it fail. It did not. It built the TIN and removed external ones the same as a clockwise poly would have.

However, I still encountered some misbehavior by the BOUND selection and rejection of TIN's. So I have re-implemented the OCD method for removing external TIN's. Perhaps that is why a clockwise  poly doesn't matter... if it ever did?

When I went back to the OCD I also rebuilt it. It no longer needs any patch within any other routines (such as BOUND). I also renamed OCD to ERASE-OUTSIDE, and it only needs the singular call from within TIN ... (if *bounden* (erase-outside *bounden*)) ...making its nomenclature intuitive and sentence-like.

Code: [Select]
; Required Express tools
; OCD: OutSide Contour Delete, was... AUGI:OCD
; Found at http://forums.augi.com/showthread.php?t=55056
; modified by RW2691 (aka. Rick)
(defun ERASE-OUTSIDE (*3D-POLY* / ss ssall e1 lst ent tp tr blst *tmpen* *LIMIT* ofspt blst)
  (vl-load-com)
  (if *3D-POLY*
    (progn ;; #A
      ;;(setq blst (distinct (mapcar '(lambda (a) (list (car a) (cadr a))) (listpol *3D-POLY*))))
      (setq blst (listpol *3D-POLY*))
      (mk_lwp blst) ;; build 2dpoly #1
      (setq *tmpen* (entlast)) ;; select 2dpoly #1
      (setq ofspt (list (- 0 9999) (- 0 9999) 0))   ;;  point at a negative 10 thousand feet past 0,0,0.
      (command "_offset" 0.005 *tmpen* ofspt "")   ;;  build 2dpoly #2 at 0.005' offset
      (setq *LIMIT* (entlast)) ;; select 2dpoly #2
      (entdel *tmpen*) ;; erase 2dpoly #1
   
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST *LIMIT* 1e-3))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list *LIMIT*)))
      (entdel *LIMIT*) ;; erase 2dpoly #2
     
      (command "_.Zoom" "0.95x")                 
      (if (and (setq ss (ssget "_WP" lst '((0 . "3DFACE")))) ;; select TINs inside polygon
               (setq ssall (ssget "_A" (list (cons 0 "3DFACE")))) ;; select all visible TINs in drawing
               )                ;; _A was _X ;; _A selects all visible items, and _X gets all drawing items
          (progn ;; #B
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ;; lst is save-group
          (foreach e1 lst (ssdel e1 ssall))  ;; removes save-group from entity list
         
          ;;====================================================================
          ;; start repeat to update globals: TL and 3DFL per PL
          (repeat (setq i (sslength ssall))
                  (setq  en (ssname ssall (setq i (1- i)))
                        ent (entget en)
                         tp (list (cdr (assoc 11 ent))  ;; translate to point
                                  (cdr (assoc 12 ent))
                                  (cdr (assoc 13 ent))
                                  )
                         tr (list (vl-position (car tp) pl)  ;; query point info
                                  (vl-position (cadr tp) pl)
                                  (vl-position (caddr tp) pl)
                                  )
                         tl (vl-remove tr tl) ;; erase TIN-Set from TIN list
                       3dfl (vl-remove en 3dfl) ;; erase object from 3DFACE list
                       ) ; end setq
                  )                         
          ;; close repeat to update globals: TL and 3DFL per PL
          ;;====================================================================
         
          (ACET-SS-ENTDEL ssall)  ;; deletes all remaining external entities
          (vl-cmdf  "._DRAWORDER" ss "" "_BACK") ;; sets to back
          (vl-cmdf "._regen")
          ) ; end progn #B
        ) ; end if 3DFACE
      ) ; end progn #A
    ) ; end if *3D-POLY*
  (princ)
  ) ;; end ERASE-OUTSIDE

I know you don't like it, but I have posted it per chance that someone else can make use of it.

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

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #663 on: May 18, 2016, 09:25:32 AM »
YMG,

In sections that change layers to draw different objects, such as in CONTOUR, it would process faster if you included the layer name within the ENTMAKE code. By doing so the active layer will never change... increasing the speed.

An example is where I plot point data from a disk file. It swaps layers for the point, a marker, a description label, an index label, and an elevation label. With a certain list it took 45 seconds. After changing the code by using ENTMAKE and assigning layers, it only took 40 seconds to process the same list. An 11% boost.

Code: [Select]
; example: for a text object with layer assigned...

(entmake
          (list (cons 0 "TEXT") ; object
                (cons 1 TxtStr) ; string
                (cons 7 "STANDARD") ; style
                (cons 8 "POINT-TEXT")  ; layer
                (cons 10 DwgPnt)  ; insert point
                (cons 11 DwgPnt)  ; custom point... not changing
                (cons 39 0.0)  ; thickness
                (cons 40 (* 0.06 (getvar "ltscale")))  ; hight by drawing scale
                (cons 50 ortang) ; rotation... using ortho-mode radians
                (cons 51 0.06981317) ; oblique radians... using slight slant
                (cons 62 256) ; color bylayer
                (cons 71 0) ; justify mirror
                (cons 72 0) ; justify left
                (cons 73 3) ; justify top
                (cons 210 (list 0.0 0.0 1.0))  ; extrusion direction               
                ) ;l
          ) ;e

; example: for a point object

(entmake
          (list (cons 0 "POINT") ; object
                (cons 6 "BYLAYER") ; linetype
                (cons 8 "POINT-MARKER") ; layer
                (cons 10 DwgPnt) ; point
                (cons 39 0.0)  ; thickness
                (cons 50 ortang) ; ortho-mode radians
                (cons 62 256) ; color bylayer
                (cons 210 (list 0.0 0.0 1.0)) ; extrusion direction
                ) ;l
          ) ;e


Additionally, by doing the above the active layer, linetype, and color are never changed. User values stay the same.

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

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #664 on: May 18, 2016, 10:41:00 AM »
Rick,

I'll check but honestly I doubt it.

By default the current layer is used when entmaking.
So what I do normally is to set the current layer outside
of the loop and then process the contour.

So I did a few test and not putting the layer is a little faster.
Although the gain is small this section of codes get used once
for every contours. But the gain is offset by setting the layer
when we go from major to minor.


Hovewer I noted that in your example, you are using
cons even for constant values

Did a few test on this and '(0 . "LWPOLYLINE) is faster
than (cons 0 "LWPOLYLINE")

Even a tiny bit faster is assigning those constant to a variable
as I do. (list ph1 ph2 ph3...)

In conclusion, personnally I prefer to set the current layer and
do without the (cons 8 layer), but doing it would not change
the performance by a lot.

ymg
« Last Edit: May 18, 2016, 10:46:12 AM by ymg »

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #665 on: May 18, 2016, 02:10:18 PM »
YMG,

I had wondered why some will mix their methods when doing an ENTMAKE. The following is fairly common...

(list '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
       (cons 8 "0")
       (cons 90 (length pt_lst))
       (cons 70 clsd)
      )

One negative I found with ENTMAKE's is that they trigger a REGEN. I had to turn REGEN's off during their screen plotting. It still makes the UCS icon flicker, and I can't get that to stop.

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

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #666 on: May 18, 2016, 03:11:34 PM »
YMG,

I might add that I do most of my programming in Pascal and by the Lazarus Compiler. With it I use ActiveX or OLE methods and the same list of points and layer differentials are processed in 15 seconds with no flicker by anything.

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

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #667 on: May 20, 2016, 03:20:47 PM »
To all,


Code: [Select]
(defun c:lbl ()   ;; COULD BE NAMED SLBL FOR "SPOT LABEL"
       (rw-cmdlbl)   ;; for drag-line... (setq ss (ssget "_F" plst (list '(0 . "SPLINE")(cons 8 ".SRF-FIN"))))
       )

; Label contour line.
(defun rw-cmdlbl (/ en0 en1 en2 azm pnt snp i dst str1 elv) 
       (rw-setcadunits)
       (setq jst1 "C" jst2 "M" sze 0.06 setdrwcolor 1 dstdsp 0) ;; for rw-SetupText
       (rw-SetupText)
       (setq j 0)
       (mk_layer (list ".SRF-LBL" 1))
       
       (while (= j 0) ; 1st while       
              (setq grdval (getvar "elevation")) ; save preset elevation (normally 0.0)
              (setq grdmod (getvar "OSNAPZ")) ; save elevation snap-mode
              (setvar "OSNAPZ" 0) ; set snap to object-grade
              (setq oldsnap (getvar "osmode") en0 nil en1 nil en2 nil)
              (setvar "osmode" 512) ;; snap nearest
             
              (setq i 0)
              (while (= i 0) ; 2nd while
                     (setq pnt (getpoint "\n\nSelect contour at label position (snap-nearest active)... "))
                     (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 "LINE") (setq i 1))
                                    (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))  ;; for testing splines ...can have phantom snap issue
                                    )
                              )
                     (if (or (not en1) (= i 0))     
                             (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
                                    )
                             )
                             
                     ;;(if (= i 1) (setq elv (cadddr (assoc 10 ed))))  ;;  **for when snapz is inactive
                     ;;(if (= i 2) (setq elv (cdr (assoc 38 ed))))  ;;  **for when snapz is inactive
                     
                     (setq elv (caddr pnt)) ;; **for when snapz is active ...this section activates snapz
                     
                     (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
                     
              (setvar "osmode" oldsnap)
              (setvar "OSNAPZ" grdmod) ; restore elevation snap-mode
              (setvar "elevation" grdval) ; restore preset-elevation (normally 0.0)
             
              (if (and (< i 9) (< j 9)) ; was (and (> i 0) (< i 9))
                   (progn
                     (rw-StoColor)
                     (rw-disablesnap)
                     (rw-AlterFont)
                     
                     (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) 150))                     
                     (command "circle" pnt dst)  ;; was... dst)
                     (setq en2 (entlast))
                                             
                     (setq snp (osnap pnt "_app"))  ;; "_end,_int" to combine snaps for other applications                   
                     (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
                     ;>>>>>=====================================================
                   
                     ;; for plain text...  cuts the line at front and back of label
                     ;(setvar "textsize" txtscale)
                     ;(setvar "cecolor" "1") ; color red 
                     ;(setq dst (+ (strlen str1) 1.0))
                     ;(setq dst (/ (* dst hgt) 2.0))
                     ;(command "circle" pnt dst)
                     ;(setq en2 (entlast))
                     ;(command "trim" en2 "" pnt "") ;; cuts the line from each side of text
                     ;(entdel en2)
                     ;(command "-style" fntdsptyp fntdspshp hgtstr "1.00" fntobldeg "n" "n" "n")
                     ;(command "-TEXT" "J" "MC" pnt brg str1)
                     
                     ;; for mtext...
                     ; mk_masked_text point string justify hight rotation color mask-state mask-color mask-ratio
                     (mk_masked_text pnt str1 5 txtscale azm 1 1 254 1.3) ;; no need to cut line
                     
                     (rw-ResetFont)
                     (rw-enablesnap)
                     (rw-RclColor)
                     )
                  )
              ) ; end 1st while
       (rw-putcadunits)
       (princ)
       ) ;; end lbl


(defun rw-SetTxtUpright (setazm / azmref ucsaxis azmaxs)   ;;   sets bearing to upright by natural and "viewtwist" perspectives
       (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
           )
       )

;; 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 ...254 slight-gray or ash                       ;
;;            mr,  mask ratio ...typical is 1.4                               ;
;; Limitation: <s> having a maximum 2040 character string <being 8 times 255> ;
(defun mk_masked_text (p s j h r c ms mc mr / x1 ent1)
   (if (= ms nil) (setq ms 2)) ;; turns off mask
   (if (= mc nil) (setq mc 250)) ;; sets to black
   (if (= mr nil) (setq mr 1.3)) ;; better than nothing

;;==================================================================
;; the below is for testing large strings... this is 2040 characters
;; with codes like \\p, only the \p is counted... being 2 characters
;; <s> will actually process this string, but I am testing it parsed
   
(setq s "*1* xt upon text over and over again\\Ptext upon text over and over 0001*2* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and   0002*3* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext* *512*
*1* xt upon text over and over again\\Ptext upon text over and over 0001*2* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and   0002*3* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext* *512*
*1* xt upon text over and over again\\Ptext upon text over and over 0001*2* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and   0002*3* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext* *512*
*1* xt upon text over and over again\\Ptext upon text over and over 0001*2* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and   0002*3* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Pt *508*")

;; rename the above <s> to <sk> in setq for testing by snap-line elevation
;; the below clears <sk> from memory upon switching back to <s>
(setq sk nil)
;;==================================================================

   (setq ent1 (entmakex
      (list '(0 . "MTEXT") 
            '(100 . "AcDbEntity")         
            '(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 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
           
            ; (foreach x (MakeMTlist s)            ;;  This did not work but it should have.
                     ; (cons (car x) (cdr x))      ;;  Replaced it with late binding below.
                     ; ) 
                     
            ) ;l
      ) ;e
      )
     
   (foreach x1 (MakeMTlist s)                                    ;; I think this is called late binding.
            (objmod ent1 (car x1) (cdr x1))                      ;; This doesn't work but it should have
            (princ "\n\n")                                       ;; There seems to be something wrong with the object
            (princ (cons (car x1) (cdr x1))) ;; print as test
            )
               
   ) ;d
   
(defun objmod (modent moditm modval / moddat)  ;; late binder
       (setq moddat (entget modent))           ; Sets moddat to the entity data
                                               ; for entity name moddat.                                           
       (setq moddat
             (subst (cons moditm modval)
                    (assoc moditm moddat)      ; Changes the moditm group in
                    moddat                     ; moddat to modval.
                    )
             )         
       (entmod moddat)                         ; Modifies entity value in drawing.       
       (entupd modent)                         ; updates entity object 
       )   
       
;; Function: MakeMtextLists, Steve Doman, 11-17-99
;; eMail: steved@onlinemac.com
;; modified by RLW 05/19/2016
(defun MakeMTlist (text / sl left k tempstr textlist)
       (setq sl (strlen text))
       
       (if (<= sl 250) ;; 250 is the DXF CODE maximum
           (setq textlist (list (cons 1 text)))           ;;  single block
           (progn                               
              (setq left 1 k sl textlist nil)  ;;  **copy method**
              (while (> k 250)                                            ;;  mutliple blocks
                     (setq tempstr (substr text left 250)
                           textlist (append textlist (list (cons 3 tempstr)))
                           left (+ left 250)
                           k (- k 250)
                           )
                     ) ;while
              (setq tempstr (substr text left sl)                         ;;  trailing block
                    textlist (append textlist (list (cons 1 tempstr)))
                    )
              );progn
           );if

       ;;(princ textlist)
       textlist
       ) ;;end defun

The above is where I have been trying to improve the MakeMtext routine. Mtext is assumed to be limited to a 255 character capacity unless you load it in a certain way... being 250 character blocks, each assigned  to the (3 . "your text") association. When your text is less than 250 characters it is assigned to (1 . "your text"). I say assumed because I have discovered that it can take 2040 characters without my having to parse anything.

Nevertheless, parsing is what I need to do. I have tried to accomplish this with two different methods. Neither have worked. It seems there is something wrong with the basic construction of the Mtext entity. As is, with a very long string, which my code loads into the s variable, it only records the portion that gets loaded into (1 . "your text"). It behaves the same with both of the methods that I have employed.

I am hoping that one of you can see the folly of my ways... apparently both ways, or even the enmake way.

To see the code operate normally, just rename the <s> variable to sk. Then change it back to s to work on the long string again. To know what was actually processed, just hit the F2 key on your keyboard. The data is printed in its output window.

Rick
« Last Edit: May 20, 2016, 03:23:49 PM by rw2691 »
Hippocrates (400BC), "Life is short, craft long, opportunity fleeting, experiment treacherous, judgment difficult."

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Triangulation (re-visited)
« Reply #668 on: May 20, 2016, 04:46:22 PM »
I think your entmakex code should look like this:
Code - Auto/Visual Lisp: [Select]
  1. (setq ent1
  2.     (append
  3.       (list
  4.         '(0 . "MTEXT")
  5.         ...
  6.       )
  7.       (MakeMTlist s)
  8.     )
  9.   )
  10. )

Your entmod code does not work because you are trying to subst gc entries that are not present in the entity list.

Using vla-addmtext may be easier.

rw2691

  • Newt
  • Posts: 133
Re: Triangulation (re-visited)
« Reply #669 on: May 21, 2016, 07:34:49 AM »
Roy,

Thank you. That made it work. But I changed it to ENTMAKE because I didn't need to do ENTMAKEX if I am not calling the OBJMOD function afterward. It now processes any volume of text.

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 ...254 slight-gray or ash                       ;
;;            mr,  mask ratio ...typical is 1.4                               ;
;; Limitation: No limitation... this can process any volume of text           ;
(defun mk_masked_text (p s j h r c ms mc mr / x1 ent1)
   (if (= ms nil) (setq ms 2)) ;; turns off mask
   (if (= mc nil) (setq mc 250)) ;; sets to black
   (if (= mr nil) (setq mr 1.3)) ;; better than nothing
   (entmake
     (append
      (list '(0 . "MTEXT") 
            '(100 . "AcDbEntity")         
            '(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 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
            ) ;l
      (MakeMTlist s)
      ) ;a
     ) ;e
   ) ;d
       
;; Function: MakeMtextLists, Steve Doman, 11-17-99
;; eMail: steved@onlinemac.com
;; modified by RLW 05/19/2016
(defun MakeMTlist (text / sl left k tempstr textlist)
       (setq sl (strlen text))       
       (if (<= sl 250) ;; 250 is the DXF CODE maximum
           (setq textlist (list (cons 1 text)))                           ;;  single block
           (progn                               
              (setq left 1 k sl textlist nil)  ;;  **copy method**
              (while (> k 250)                                            ;;  mutliple blocks
                     (setq tempstr (substr text left 250)
                           textlist (append textlist (list (cons 3 tempstr)))
                           left (+ left 250)
                           k (- k 250)
                           )
                     ) ;while
              (setq tempstr (substr text left sl)                         ;;  final block
                    textlist (append textlist (list (cons 1 tempstr)))
                    )
              );progn
           );if
       textlist
       ) ;end defun

Rick
« Last Edit: May 21, 2016, 07:50:50 AM by rw2691 »
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 #670 on: May 22, 2016, 06:26:25 AM »
Ymg, I want to tell you that it's possible to solve vertex contour intersection... I created some routines based on theme of contouring and I managed to make it possible to pass problematic vertex in this way: when contour hit vertex consider situation that one of connected 3d faces will have 3 points of intersection with level plane... 2 of those 3 points will be the same: equal to vertex and 1 point will lie at the opposite edge and that point is solution for making contour continue to form shape of contour... Other not good 3d faces around vertex may have only 2 intersecting points: equal to vertex while opposite edge won't have intersecting point with plane at level of contour... I write this message from mobile phone and currently I don't have www connection with this old laptop where I wrote those routines... But in a week when I get home, I'll post my versions that are slower lisps than your Triang... But I think it's good to experiment and who knows maybe someday they'll be improved to work faster... For those that need only additions to created contouring I wrote dynamic version, but they are all without parabolic curving - like your smoothing 0... Regards and enjoy wherever you are, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #671 on: May 23, 2016, 07:05:44 AM »
Hi Marko,

The problem I had with even contour is currently solved in
version 0.7.0  (Not published yet). 

So yes you are right It can be done.

Right now trying to accelerate it.  I've also change
the contour subroutine to be called with different parameters
to enable updating contours when flipping faces.

I will certainly look into your version and , there are more than one way
to skin a cat.


ymg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #672 on: June 10, 2016, 09:54:35 AM »
Here ymg, take a look... The swamp works now, but my archive was written 2 week ago...
Like I promised I'll post it here...

Regards, M.R.

BTW. I used your (getz) as I think it's faster than my version of intersection line plane by 3 points...
HTH.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #673 on: June 10, 2016, 12:42:37 PM »
Marko,

Will look at it when I have a chance.

Right now just came back from Europe to discover that
I had a minor flood in the house.  So I am doing some
cleaning-up and demolition

Thanks for your contribution.

ymg

irot

  • Guest
Re: Triangulation (re-visited)
« Reply #674 on: July 06, 2016, 08:41:19 AM »
I've been trying to run TIN command with BricsCAD 16 and got the following error:
Quote
; ----- Error around expression -----
(VLAX-CURVE-GETENDPARAM EN)
;
Error: bad argument type <NIL> ; expected <NUMBER> at [+ ]
Any reason as to why it's not working?