To all,
(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