Topic: Dynamic Block Insertion For Contour Label Orientation ???

[ymg]

Here is a quick and dirty piece of code to label contour.

It makes use of of dynamic block elv that you can find in attached drawing.

I would like this block to keep a readable orientation.  Meaning no upside down
text and keeping sideway or near vertical text always in same orientation.

I am not too good with these constraint,  could anybody help?

Code: [Select]

;; lbl by ymg                                                                                       
;;                                                                                                 
;; Insert Dynamic Block "elv" along a polyline.                                                     
;; Modified from a post by cab                                                                                                 

(defun c:lbl (/ )
    (if (setq i 0
      s (ssget '((0 . "LWPOLYLINE")
(8 . "Contour Major")
)
)       
)     
        (progn
    (command "._Undo" "_begin")
            (repeat (sslength s)
        (setq ent (ssname s i)
                        i (1+ i)
        )

        (setvar "CLAYER" "Contour Label")       
     
                (setq  spacing  500
                           len (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
                  tspc (/ spc 2)
                )
     
     
        (while (< tspc len)
            (command "-insert" "elv" "_near" (vlax-curve-getpointatdist ent tspc) "1" "" "")
                    (setq tspc (+ tspc spc))
                )
     
    );end repeat
 
            (command "._Undo" "_end")
); end progn
    );end if  
    (princ)
)


ymg

[Tharwat]

Try this ...

Code - Auto/Visual Lisp: [Select]

1. (defun c:Test (/ *error* i s ent spc n c cm r d p)
2. ;;;     Tharwat 29.07.2013      ;;;
3.   (or doc
4.       (setq doc (vla-get-activedocument (vlax-get-acad-object)))
5.   )
6.   (defun *error* (x)
7.     (if cm
8.       (mapcar 'setvar
9.               '(cmdecho attreq attdia clayer)
10.               (list cm r d c)
11.       )
12.     )
13.     (if doc
14.       (vla-endundomark doc)
15.     )
16.     (princ "\n*Cancel*")
17.   )
18.   (if
19.     (and (if (not (tblsearch "LAYER" "Contour Label"))
20.            (progn
21.              (alert "Layer < Contour Label > is not found in drawing !!")
22.              nil
23.            )
24.            t
25.          )
26.          (setq s (ssget '((0 . "LWPOLYLINE")
27.                           (8 . "Contour Major")
28.                          )
29.                  )
30.          )
31.     )
32.      (progn
33.        (setq c  (getvar 'clayer)
34.              r  (getvar 'attreq)
35.              d  (getvar 'attdia)
36.              cm (getvar 'cmdecho)
37.        )
38.        (mapcar 'setvar
39.                '(cmdecho attreq attdia clayer)
40.                (list 0 1 0 "Contour Label")
41.        )
42.        (vla-startUndoMark doc)
43.        (repeat (setq i (sslength s))
44.          (setq ent (ssname s (setq i (1- i))))
45.          (setq spc 500.
46.                n   spc
47.          )
48.          (while (setq p (vlax-curve-getpointatdist ent spc))
49.            (command "_.-insert" "elv" "_non" p "1" "0")
50.            (setq spc (+ n spc))
51.          )
52.        )
53.        (mapcar 'setvar
54.                '(cmdecho attreq attdia clayer)
55.                (list cm r d c)
56.        )
57.        (vla-endundomark doc)
58.      )
59.   )
60.   (princ)
61. )
62. (vl-load-com)
63.  

[ymg]

Tharwat,

This gives me label always horizontal.

What I am after is the label should be tangent to the contour, but the attribute should
never align in the (180 --> 90 )  or the (360-->180).  When we are in this range the
label should be flipped by 180 degrees.

Thanks,

ymg

[ymg]

Code below does it !

Any smarter way ?

I would think that with proper constraint on the block,
we could do without creating the second point on the curve
to get the direction of the label.

So contrary to what I stated in previous post the rotation
parameter must not be between  90 and 270.
In that case we flip by 180 degrees.

Code - Auto/Visual Lisp: [Select]

1.  
2. ;;;     Tharwat 29.07.2013      ;;;
3. ;;; Modified ymg                ;;;
4.  
5. (defun c:lbl (/ *error* i s ent spc n c cm r d p)
6.  
7.   (or doc
8.       (setq doc (vla-get-activedocument (vlax-get-acad-object)))
9.   )
10.  
11.   (defun *error* (x)
12.      (if cm
13.         (mapcar 'setvar
14.                     '(cmdecho attreq attdia clayer)
15.                     (list cm r d c)
16.         )
17.      )
18.      (if doc (vla-endundomark doc))
19.      (princ "\n*Cancel*")
20.   )
21.  
22.   (if (and (if (not (tblsearch "LAYER" "Contour Label"))
23.               (progn
24.                   (alert "Layer < Contour Label > is not found in drawing !!")
25.                    nil
26.               )
27.               t
28.            )
29.            (setq s (ssget '((0 . "LWPOLYLINE")
30.                             (8 . "Contour Major")
31.                            )
32.                    )
33.            )
34.       )
35.       (progn
36.           (setq c (getvar 'clayer)
37.                 r (getvar 'attreq)
38.                 d (getvar 'attdia)
39.                cm (getvar 'cmdecho)
40.           )
41.  
42.           (mapcar 'setvar
43.                      '(cmdecho attdia attreq clayer)
44.                      (list 0 1 0 "Contour Label")
45.           )
46.  
47.           (vla-startUndoMark doc)
48.  
49.           (setq spacing 500)
50.           (repeat (setq i (sslength s))
51.               (setq ent (ssname s (setq i (1- i)))
52.                     start (/ spacing 2)
53.               )
54.               (while (setq p (vlax-curve-getpointatdist ent start))
55.                  (setq p1 (vlax-curve-getpointatdist ent (- start 10))
56.                        rot (rtd (angle p1 p))
57.                  )
58.                  
59.                  (cond
60.                      ((< 90 rot 270) (setq rot (+ rot 180)))
61.                  )
62.                  
63.                  (command "_.-insert" "elv" "_non" p "1" rot)
64.                  (setq start (+ start spacing))
65.               )
66.           )
67.           (mapcar 'setvar
68.                      '(cmdecho attreq attdia clayer)
69.                      (list cm r d c)
70.           )
71.           (vla-endundomark doc)
72.      )
73.   )
74.   (princ)
75. )
76. (defun rtd (a) (* 180.0 (/ a pi)))
77. (vl-load-com)
78.  

ymg

[snownut2]

You could use this to get the rotation angle and only need 1 point.

Never mind upon testing results are erratic....

[Lee Mac]

This is the function that I use regularly for this purpose:

Code - Auto/Visual Lisp: [Select]

1. ;; Make Readable  -  Lee Mac
2. ;; Returns a given angle corrected for text readability
3.  
4. (defun LM:MakeReadable ( a )
5.     (   (lambda ( a ) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (+ a pi) a))
6.         (rem (+ a pi pi) (+ pi pi))
7.     )
8. )

You could use it in the following way:

Code - Auto/Visual Lisp: [Select]

1. (defun c:lbl ( / blk bln dis ent idx inc ins sel spc )
2.     (setq bln "Contour Label") ;; Block name
3.     (cond
4.         (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
5.             (princ "\nCurrent layer locked.")
6.         )
7.         (   (not
8.                 (or (tblsearch "block" (setq blk bln))
9.                     (setq blk (findfile (strcat bln ".dwg")))
10.                 )
11.             )
12.             (princ (strcat "\n" bln " block not found."))
13.         )
14.         (   (setq sel (ssget '((0 . "LWPOLYLINE") (8 . "Contour Major"))))
15.             (setq spc (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
16.                   dis 500.0
17.             )
18.             (repeat (setq idx (sslength sel))
19.                 (setq ent (ssname sel (setq idx (1- idx)))
20.                       inc (- (/ dis 2.0) dis)
21.                 )
22.                 (while (setq ins (vlax-curve-getpointatdist ent (setq inc (+ inc dis))))
23.                     (vla-insertblock spc (vlax-3D-point ins) blk 1.0 1.0 1.0
24.                         (LM:makereadable (angle '(0.0 0.0) (trans (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent ins)) 0 1)))
25.                     )
26.                 )
27.             )
28.         )
29.     )
30.     (princ)
31. )
32.  
33. ;; Make Readable  -  Lee Mac
34. ;; Returns a given angle corrected for text readability
35.  
36. (defun LM:MakeReadable ( a )
37.     (   (lambda ( a ) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (+ a pi) a))
38.         (rem (+ a pi pi) (+ pi pi))
39.     )
40. )

Note that the above code is untested!

[ymg]

This is the function that I use regularly for this purpose

Thanks Lee,

Would this be equivalent ?

Code - Auto/Visual Lisp: [Select]

1. (rem (cond ((< (* pi 0.5) a (* pi 1.5))(+ a pi))(t a))(+ pi pi))

I like your example function and getting rid of the "command" with vla-insertblock.

I did look into the first derivative but could not get it to work. You've shown me!

ymg

[Lee Mac]

Would this be equivalent ?

Code - Auto/Visual Lisp: [Select]

1. (rem (cond ((< (* pi 0.5) a (* pi 1.5))(+ a pi))(t a))(+ pi pi))

No, since my function accounts for any arguments -2π ≤ a, whereas your version will perform incorrectly for supplied angles outside the range 0 ≤ a ≤ 2π

I like your example function and getting rid of the "command" with vla-insertblock.

I did look into the first derivative but could not get it to work. You've shown me!

You're welcome!