Jump to content

Modify Lisp

feargt

By feargt
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

feargt Proficient

feargt

Posted
Posted

Hi,

 

I have a lisp routine that we use in our office for labeling polylines with a global width.

ie if I have a polyline (representing a pipe) that has a global width of 0.2, the routine will label all segments of the polyline with DN200

 

What I would like to do is to change this code so that if a polyline segment is smaller than 10 units, then this segment does not get a label.

 

For example, a polyline with a lenght of 29 units has 3 segments, 2 segments have a length of 12 units and a third segment with 5 units.

I want the 2 segements of 12 units to be labeled but not the third segment with 5 units

 

_________________

 

And also if no segment is greater than 10 units then label polyline once at the midpoint.

 

______________

 

My first problem here is that I am not sure where in the code I would need to make changes to.

 

If anyone can assist me or show me some examples of how this might be achieved it would be very much appreciated.

 

thanks

 

 
				;This routine was provided by ASMI.
(vl-load-com)
(defun c:Label_Width (/	      js      htx     AcDoc   cLay    Space
	      nw_style	      obj     dxf_ent ename   t_mod
	      key     pr      t_char  js_text pt      deriv
	      rtx     nw_obj  n
	     )
 (princ "\nSelect a polyline.")
 (while
   (null
     (setq js
     (ssget "_+.:E:S"
	    (list
	      '(0 . "*POLYLINE")
	      (cons 67
		    (if	(eq (getvar "CVPORT") 1)
		      1
		      0
		    )
	      )
	      (cons 410
		    (if	(eq (getvar "CVPORT") 1)
		      (getvar "CTAB")
		      "Model"
		    )
	      )
	    )
     )
     )
   )
    (princ "\nIsn't an available object for this fonction!")
 )
 (setq
   obj	    (ssname js 0)
   dxf_ent (entget obj)
   ename   (vlax-ename->vla-object obj)
   cLay    (vla-get-Layer ename)
   t_mod   '+
   key	    "Yes"
 )
 (cond
   ((assoc 43 dxf_ent)
    (setq
      AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
      Space
     (if (= 1 (getvar "CVPORT"))
       (vla-get-PaperSpace AcDoc)
       (vla-get-ModelSpace AcDoc)
     )
    )
    (repeat 2
      (setq pr	     -0.5
     t_char  64
     js_text (ssadd)
      )
      (if (eq key "Yes")
 (repeat (fix (vlax-curve-getEndParam ename))
   (setq
     pt	   (vlax-curve-GetpointAtParam ename (setq pr (1+ pr)))
     deriv (vlax-curve-getFirstDeriv ename pr)
     rtx   (- (atan (cadr deriv) (car deriv))
	      (angle '(0 0 0) (getvar "UCSXDIR"))
	   )
   )
   (setq nw_obj
	  (vla-addMtext
	    Space
	    (vlax-3d-point
	      (setq pt (polar pt
			      ((eval t_mod) rtx (* pi 0.5))
			      (getvar "TEXTSIZE")
		       )
	      )
	    )
	    0.0
	    (strcat
	      "DN"
	      "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
	      (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
	      ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
	    )
	  )
   )
   (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
     (setq rtx (+ rtx pi))
   )
   (mapcar
     '(lambda (pr val)
	(vlax-put nw_obj pr val)
      )
     (list 'AttachmentPoint   'Height
	   'DrawingDirection  'InsertionPoint
	   'StyleName	      'Layer
	   'Rotation
	  )
     (list 5
	   (getvar "TEXTSIZE")
	   5
	   pt
	   (getvar "TEXTSTYLE")
	   cLay
	   rtx
     )
   )
   (ssadd (entlast) js_text)
 )
      )
      (if (not (eq t_mod '-))
 (progn
   (initget "Yes No")
   (if (eq (setq
	     key (getkword
		   "\nPut labels on other side [Yes/No]? <No>: "
		 )
	   )
	   "Yes"
       )
     (progn (setq n -1
		  t_mod	'-
	    )
	    (repeat (sslength js_text)
	      (entdel (ssname js_text (setq n (1+ n))))
	    )
     )
     (setq t_mod '-)
   )
 )
      )
    )
   )
   (T (princ "\nThis polyine does not have a constant width!"))
 )
 (prin1)
)

CAB Proficient

CAB

Posted
Posted

Try this:

 

;;This routine was provided by ASMI.
(vl-load-com)
(defun c:Label_Width (/	      js      htx     AcDoc   cLay    Space
	      nw_style	      obj     dxf_ent ename   t_mod
	      key     pr      t_char  js_text pt      deriv
	      rtx     nw_obj  n  par  len
	     )
 (princ "\nSelect a polyline.")
 (while
   (null
     (setq js
     (ssget "_+.:E:S"
	    (list
	      '(0 . "*POLYLINE")
	      (cons 67
		    (if	(eq (getvar "CVPORT") 1)
		      1
		      0
		    )
	      )
	      (cons 410
		    (if	(eq (getvar "CVPORT") 1)
		      (getvar "CTAB")
		      "Model"
		    )
	      )
	    )
     )
     )
   )
    (princ "\nIsn't an available object for this fonction!")
 )
 (setq
   obj	    (ssname js 0)
   dxf_ent (entget obj)
   ename   (vlax-ename->vla-object obj)
   cLay    (vla-get-Layer ename)
   t_mod   '+
   key	    "Yes"
 )
 (cond
   ((assoc 43 dxf_ent)
    (setq
      AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
      Space
     (if (= 1 (getvar "CVPORT"))
       (vla-get-PaperSpace AcDoc)
       (vla-get-ModelSpace AcDoc)
     )
    )
    (repeat 2
      (setq pr	     -0.5
     t_char  64
     js_text (ssadd)
      )
      (if (eq key "Yes")
 (repeat (fix (vlax-curve-getEndParam ename))
   (setq
     pt	   (vlax-curve-GetpointAtParam ename (setq pr (1+ pr)))
     deriv (vlax-curve-getFirstDeriv ename pr)
     rtx   (- (atan (cadr deriv) (car deriv))
	      (angle '(0 0 0) (getvar "UCSXDIR"))
	   )
   )
          ;;  Test for segment length - CAB
          ;;  vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
          (setq par (fix pr))
          (if (= par (fix (vlax-curve-getEndParam ename)))
            (setq len (vlax-curve-getdistatparam ename (vlax-curve-getEndParam ename)))
            (setq len (vlax-curve-getdistatparam ename (1+ par)))
          )
          (setq len (- len (vlax-curve-getdistatparam ename par)))
                
          (if (> len 10.0) ; Min Segment Length
            (progn
          ;;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
   (setq nw_obj
	  (vla-addMtext
	    Space
	    (vlax-3d-point
	      (setq pt (polar pt
			      ((eval t_mod) rtx (* pi 0.5))
			      (getvar "TEXTSIZE")
		       )
	      )
	    )
	    0.0
	    (strcat
	      "DN"
	      "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
	      (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
	      ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
	    )
	  )
   )
   (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
     (setq rtx (+ rtx pi))
   )
   (mapcar
     '(lambda (pr val)
	(vlax-put nw_obj pr val)
      )
     (list 'AttachmentPoint   'Height
	   'DrawingDirection  'InsertionPoint
	   'StyleName	      'Layer
	   'Rotation
	  )
     (list 5
	   (getvar "TEXTSIZE")
	   5
	   pt
	   (getvar "TEXTSTYLE")
	   cLay
	   rtx
     )
   )
   (ssadd (entlast) js_text)
          ) ; CAB
            ) ; CAB
 )
      )
      (if (not (eq t_mod '-))
 (progn
   (initget "Yes No")
   (if (eq (setq
	     key (getkword
		   "\nPut labels on other side [Yes/No]? <No>: "
		 )
	   )
	   "Yes"
       )
     (progn (setq n -1
		  t_mod	'-
	    )
	    (repeat (sslength js_text)
	      (entdel (ssname js_text (setq n (1+ n))))
	    )
     )
     (setq t_mod '-)
   )
 )
      )
    )
   )
   (T (princ "\nThis polyine does not have a constant width!"))
 )
 (prin1)
)

ronjonp Grand Master

ronjonp

Posted
Posted

This seems to work for me. *too slow again

 

*changed flipping labels to picking a point..enter to end.

 


;This routine was provided by ASMI.
; Additions by RJP 05-29-2009
(defun c:label_width (/      acdoc  clay   d      deriv  dxf_ent       ename  flag   js     js_text
                     key    nw_obj obj    out    p      pr     pt     pt2    rtx    space  t_char
                     t_mod  val    x      w
                    )
 (vl-load-com)
 (princ "\nSelect a polyline.")
 (while (null (setq js (ssget "_+.:E:S"
                              (list '(0 . "*POLYLINE")
                                    (cons 67
                                          (if (eq (getvar "CVPORT") 1)
                                            1
                                            0
                                          )
                                    )
                                    (cons 410
                                          (if (eq (getvar "CVPORT") 1)
                                            (getvar "CTAB")
                                            "Model"
                                          )
                                    )
                              )
                       )
              )
        )
   (princ "\nIsn't an available object for this function!")
 )
 (setq obj     (ssname js 0)
       dxf_ent (entget obj)
       ename   (vlax-ename->vla-object obj)
       clay    (vla-get-layer ename)
       t_mod   '+
       key     "Yes"
 )
 (if (setq w (cdr (assoc 43 dxf_ent)))
   (progn (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
                space (if (= 1 (getvar "CVPORT"))
                        (vla-get-paperspace acdoc)
                        (vla-get-modelspace acdoc)
                      )
                x     0.0
          )
          ;;RJP check if at least one segment is longer than 10
          (repeat (fix (vlax-curve-getendparam ename))
            (if (> (distance (vlax-curve-getpointatparam ename x)
                             (vlax-curve-getpointatparam ename (setq x (1+ x)))
                   )
                   10.
                )
              (setq flag t)
            )
          )
          (setq pr      -0.5
                t_char  64
                js_text (ssadd)
                x       0.0
          )
          (if (and (eq key "Yes") flag)
            ;;RJP add - If at least one segment is greater than 10 
            (repeat (fix (vlax-curve-getendparam ename))
              (setq pt    (vlax-curve-getpointatparam ename (setq pr (1+ pr)))
                    deriv (vlax-curve-getfirstderiv ename pr)
                    rtx   (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                    d     (distance (vlax-curve-getpointatparam ename x)
                                    (vlax-curve-getpointatparam ename (setq x (1+ x)))
                          )
              )
              (if (> d 5)
                ;;RJP add - If segment length > 5 rock and roll (does not calculate length along arc segment) it's pt to pt
                (progn (setq nw_obj
                              (vla-addmtext space
                                            (vlax-3d-point (setq pt (polar pt
                                                                           ((eval t_mod) rtx (* pi 0.5))
                                                                           (+ (getvar "TEXTSIZE") (/ w 2.))
                                                                    )
                                                           )
                                            )
                                            0.0
                                            (strcat "DN"
                                                    "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                                                    (itoa (vla-get-objectid (vlax-ename->vla-object obj)))
                                                    ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
                                            )
                              )
                       )
                       (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
                         (setq rtx (+ rtx pi))
                       )
                       (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
                               (list 'attachmentpoint   'height            'drawingdirection
                                     'insertionpoint    'stylename         'layer
                                     'rotation
                                    )
                               (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") clay rtx)
                       )
                       (setq out (cons nw_obj out))
                )
              )
            )
            ;;RJP add - Else no segments greater than 10 get midpoint of polyline
            (progn (setq pt    (vlax-curve-getpointatdist
                                 ename
                                 (/ (vlax-curve-getdistatpoint ename (vlax-curve-getendpoint ename)) 2)
                               )
                         deriv (vlax-curve-getfirstderiv ename (vlax-curve-getparamatpoint ename pt))
                         rtx   (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                   )
                   (setq
                     nw_obj (vla-addmtext space
                                          (vlax-3d-point (setq pt (polar pt
                                                                         ((eval t_mod) rtx (* pi 0.5))
                                                                         (+ (getvar "TEXTSIZE") (/ w 2.))
                                                                  )
                                                         )
                                          )
                                          0.0
                                          (strcat "DN"
                                                  "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                                                  (itoa (vla-get-objectid (vlax-ename->vla-object obj)))
                                                  ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
                                          )
                            )
                   )
                   (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
                     (setq rtx (+ rtx pi))
                   )
                   (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
                           (list 'attachmentpoint   'height            'drawingdirection
                                 'insertionpoint    'stylename         'layer
                                 'rotation
                                )
                           (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") clay rtx)
                   )
                   (setq out (cons nw_obj out))
            )
          )
          ;;RJP add - pickpoint to flip labels or enter to exit
          (while (setq p (getpoint "\nPick a point to flip labels :"))
            (foreach txt out
              (vla-move txt
                        (vla-get-insertionpoint txt)
                        (vlax-3d-point
                          (polar (setq pt (vlax-get txt 'insertionpoint))
                                 (angle pt (setq pt2 (vlax-curve-getclosestpointto ename pt)))
                                 (* 2. (distance pt pt2))
                          )
                        )
              )
            )
          )
   )
   (princ "\nThis polyline does not have a constant width!")
 )
 (prin1)
)

dani Rookie

dani

Posted
Posted
This seems to work for me. *too slow again

 

;This routine was provided by ASMI.
(vl-load-com)
(defun c:label_width (/      acdoc  clay   d      deriv  dxf_ent       ename  flag   js     js_text
                     key    n      nw_obj obj    pr     pt     rtx    space  t_char t_mod  val
                     x
                    )
 (princ "\nSelect a polyline.")
 (while (null (setq js (ssget "_+.:E:S"
                              (list '(0 . "*POLYLINE")
                                    (cons 67
                                          (if (eq (getvar "CVPORT") 1)
                                            1
                                            0
                                          )
                                    )
                                    (cons 410
                                          (if (eq (getvar "CVPORT") 1)
                                            (getvar "CTAB")
                                            "Model"
                                          )
                                    )
                              )
                       )
              )
        )
   (princ "\nIsn't an available object for this function!")
 )
 (setq obj     (ssname js 0)
       dxf_ent (entget obj)
       ename   (vlax-ename->vla-object obj)
       clay    (vla-get-layer ename)
       t_mod   '+
       key     "Yes"
 )
 (cond
   ((assoc 43 dxf_ent)
    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          space (if (= 1 (getvar "CVPORT"))
                  (vla-get-paperspace acdoc)
                  (vla-get-modelspace acdoc)
                )
          x     0.0
    )
    ;;RJP check if at least one segment is longer than 10
    (repeat (fix (vlax-curve-getendparam ename))
      (if (> (distance (vlax-curve-getpointatparam ename x)
                       (vlax-curve-getpointatparam ename (setq x (1+ x)))
             )
             10.
          )
        (setq flag t)
      )
    )
    (repeat 2
      (setq pr      -0.5
            t_char  64
            js_text (ssadd)
            x       0.0
      )
      (if (and (eq key "Yes") flag)
        (repeat (fix (vlax-curve-getendparam ename))
          (setq pt    (vlax-curve-getpointatparam ename (setq pr (1+ pr)))
                deriv (vlax-curve-getfirstderiv ename pr)
                rtx   (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                d     (distance (vlax-curve-getpointatparam ename x)
                                (vlax-curve-getpointatparam ename (setq x (1+ x)))
                      )
          )
          (if (> d 5)
            (progn (setq
                     nw_obj (vla-addmtext
                              space
                              (vlax-3d-point
                                (setq pt (polar pt ((eval t_mod) rtx (* pi 0.5)) (getvar "TEXTSIZE")))
                              )
                              0.0
                              (strcat "DN"
                                      "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                                      (itoa (vla-get-objectid (vlax-ename->vla-object obj)))
                                      ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
                              )
                            )
                   )
                   (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
                     (setq rtx (+ rtx pi))
                   )
                   (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
                           (list 'attachmentpoint   'height            'drawingdirection
                                 'insertionpoint    'stylename         'layer
                                 'rotation
                                )
                           (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") clay rtx)
                   )
                   (ssadd (entlast) js_text)
            )
          )
        )
        (progn (setq pt    (vlax-curve-getpointatdist
                             ename
                             (/ (vlax-curve-getdistatpoint ename (vlax-curve-getendpoint ename)) 2)
                           )
                     deriv (vlax-curve-getfirstderiv ename (vlax-curve-getparamatpoint ename pt))
                     rtx   (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
               )
               (setq nw_obj (vla-addmtext
                              space
                              (vlax-3d-point
                                (setq pt (polar pt ((eval t_mod) rtx (* pi 0.5)) (getvar "TEXTSIZE")))
                              )
                              0.0
                              (strcat "DN"
                                      "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                                      (itoa (vla-get-objectid (vlax-ename->vla-object obj)))
                                      ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
                              )
                            )
               )
               (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
                 (setq rtx (+ rtx pi))
               )
               (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
                       (list 'attachmentpoint   'height            'drawingdirection
                             'insertionpoint    'stylename         'layer
                             'rotation
                            )
                       (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") clay rtx)
               )
               (ssadd (entlast) js_text)
        )
      )
      (if (not (eq t_mod '-))
        (progn (initget "Yes No")
               (if (eq (setq key (getkword "\nPut labels on other side [Yes/No]? <No>: "))
                       "Yes"
                   )
                 (progn (setq n -1
                              t_mod '-
                        )
                        (repeat (sslength js_text) (entdel (ssname js_text (setq n (1+ n)))))
                 )
                 (setq t_mod '-)
               )
        )
      )
    )
   )
   (t (princ "\nThis polyline does not have a constant width!"))
 )
 (prin1)
)

 

Was ist wenn Poly breiter ist, dan past das nicht.

Poly-Model.jpg

ronjonp Grand Master

ronjonp

Posted
Posted

Dani,

 

A picture is worth a 1000 words :)...I reposted the code, give it a try.

feargt Proficient

feargt

Posted
  • Author
Posted
Try this:

 

;;This routine was provided by ASMI.
(vl-load-com)
(defun c:Label_Width (/          js      htx     AcDoc   cLay    Space
             nw_style          obj     dxf_ent ename   t_mod
             key     pr      t_char  js_text pt      deriv
             rtx     nw_obj  n  par  len
            )
 (princ "\nSelect a polyline.")
 (while
   (null
     (setq js
        (ssget "_+.:E:S"
           (list
             '(0 . "*POLYLINE")
             (cons 67
               (if    (eq (getvar "CVPORT") 1)
                 1
                 0
               )
             )
             (cons 410
               (if    (eq (getvar "CVPORT") 1)
                 (getvar "CTAB")
                 "Model"
               )
             )
           )
        )
     )
   )
    (princ "\nIsn't an available object for this fonction!")
 )
 (setq
   obj        (ssname js 0)
   dxf_ent (entget obj)
   ename   (vlax-ename->vla-object obj)
   cLay    (vla-get-Layer ename)
   t_mod   '+
   key        "Yes"
 )
 (cond
   ((assoc 43 dxf_ent)
    (setq
      AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
      Space
        (if (= 1 (getvar "CVPORT"))
          (vla-get-PaperSpace AcDoc)
          (vla-get-ModelSpace AcDoc)
        )
    )
    (repeat 2
      (setq pr         -0.5
        t_char  64
        js_text (ssadd)
      )
      (if (eq key "Yes")
    (repeat (fix (vlax-curve-getEndParam ename))
      (setq
        pt       (vlax-curve-GetpointAtParam ename (setq pr (1+ pr)))
        deriv (vlax-curve-getFirstDeriv ename pr)
        rtx   (- (atan (cadr deriv) (car deriv))
             (angle '(0 0 0) (getvar "UCSXDIR"))
          )
      )
          ;;  Test for segment length - CAB
          ;;  vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
          (setq par (fix pr))
          (if (= par (fix (vlax-curve-getEndParam ename)))
            (setq len (vlax-curve-getdistatparam ename (vlax-curve-getEndParam ename)))
            (setq len (vlax-curve-getdistatparam ename (1+ par)))
          )
          (setq len (- len (vlax-curve-getdistatparam ename par)))
                
          (if (> len 10.0) ; Min Segment Length
            (progn
          ;;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      (setq nw_obj
         (vla-addMtext
           Space
           (vlax-3d-point
             (setq pt (polar pt
                     ((eval t_mod) rtx (* pi 0.5))
                     (getvar "TEXTSIZE")
                  )
             )
           )
           0.0
           (strcat
             "DN"
             "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
             (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
             ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
           )
         )
      )
      (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
        (setq rtx (+ rtx pi))
      )
      (mapcar
        '(lambda (pr val)
       (vlax-put nw_obj pr val)
         )
        (list 'AttachmentPoint   'Height
          'DrawingDirection  'InsertionPoint
          'StyleName          'Layer
          'Rotation
         )
        (list 5
          (getvar "TEXTSIZE")
          5
          pt
          (getvar "TEXTSTYLE")
          cLay
          rtx
        )
      )
      (ssadd (entlast) js_text)
          ) ; CAB
            ) ; CAB
    )
      )
      (if (not (eq t_mod '-))
    (progn
      (initget "Yes No")
      (if (eq (setq
            key (getkword
              "\nPut labels on other side [Yes/No]? <No>: "
            )
          )
          "Yes"
          )
        (progn (setq n -1
             t_mod    '-
           )
           (repeat (sslength js_text)
             (entdel (ssname js_text (setq n (1+ n))))
           )
        )
        (setq t_mod '-)
      )
    )
      )
    )
   )
   (T (princ "\nThis polyine does not have a constant width!"))
 )
 (prin1)
)

 

 

many thanks for taking the time on this.

 

Unfortunatley this does not seem to work on polylines with no segment longer than 10 units

 

It works on plines with several segments where some are shorter than 10 units

 

The version by ronjonp seems to do exactly what I need, I will just need to test it a bit more on Monday in the office

feargt Proficient

feargt

Posted
  • Author
Posted
This seems to work for me. *too slow again

 

*changed flipping labels to picking a point..enter to end.

 


;This routine was provided by ASMI.
; Additions by RJP 05-29-2009
(defun c:label_width (/      acdoc  clay   d      deriv  dxf_ent       ename  flag   js     js_text
                     key    nw_obj obj    out    p      pr     pt     pt2    rtx    space  t_char
                     t_mod  val    x      w
                    )
 (vl-load-com)
 (princ "\nSelect a polyline.")
 (while (null (setq js (ssget "_+.:E:S"
                              (list '(0 . "*POLYLINE")
                                    (cons 67
                                          (if (eq (getvar "CVPORT") 1)
                                            1
                                            0
                                          )
                                    )
                                    (cons 410
                                          (if (eq (getvar "CVPORT") 1)
                                            (getvar "CTAB")
                                            "Model"
                                          )
                                    )
                              )
                       )
              )
        )
   (princ "\nIsn't an available object for this function!")
 )
 (setq obj     (ssname js 0)
       dxf_ent (entget obj)
       ename   (vlax-ename->vla-object obj)
       clay    (vla-get-layer ename)
       t_mod   '+
       key     "Yes"
 )
 (if (setq w (cdr (assoc 43 dxf_ent)))
   (progn (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
                space (if (= 1 (getvar "CVPORT"))
                        (vla-get-paperspace acdoc)
                        (vla-get-modelspace acdoc)
                      )
                x     0.0
          )
          ;;RJP check if at least one segment is longer than 10
          (repeat (fix (vlax-curve-getendparam ename))
            (if (> (distance (vlax-curve-getpointatparam ename x)
                             (vlax-curve-getpointatparam ename (setq x (1+ x)))
                   )
                   10.
                )
              (setq flag t)
            )
          )
          (setq pr      -0.5
                t_char  64
                js_text (ssadd)
                x       0.0
          )
          (if (and (eq key "Yes") flag)
            ;;RJP add - If at least one segment is greater than 10 
            (repeat (fix (vlax-curve-getendparam ename))
              (setq pt    (vlax-curve-getpointatparam ename (setq pr (1+ pr)))
                    deriv (vlax-curve-getfirstderiv ename pr)
                    rtx   (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                    d     (distance (vlax-curve-getpointatparam ename x)
                                    (vlax-curve-getpointatparam ename (setq x (1+ x)))
                          )
              )
              (if (> d 5)
                ;;RJP add - If segment length > 5 rock and roll (does not calculate length along arc segment) it's pt to pt
                (progn (setq nw_obj
                              (vla-addmtext space
                                            (vlax-3d-point (setq pt (polar pt
                                                                           ((eval t_mod) rtx (* pi 0.5))
                                                                           (+ (getvar "TEXTSIZE") (/ w 2.))
                                                                    )
                                                           )
                                            )
                                            0.0
                                            (strcat "DN"
                                                    "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                                                    (itoa (vla-get-objectid (vlax-ename->vla-object obj)))
                                                    ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
                                            )
                              )
                       )
                       (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
                         (setq rtx (+ rtx pi))
                       )
                       (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
                               (list 'attachmentpoint   'height            'drawingdirection
                                     'insertionpoint    'stylename         'layer
                                     'rotation
                                    )
                               (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") clay rtx)
                       )
                       (setq out (cons nw_obj out))
                )
              )
            )
            ;;RJP add - Else no segments greater than 10 get midpoint of polyline
            (progn (setq pt    (vlax-curve-getpointatdist
                                 ename
                                 (/ (vlax-curve-getdistatpoint ename (vlax-curve-getendpoint ename)) 2)
                               )
                         deriv (vlax-curve-getfirstderiv ename (vlax-curve-getparamatpoint ename pt))
                         rtx   (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                   )
                   (setq
                     nw_obj (vla-addmtext space
                                          (vlax-3d-point (setq pt (polar pt
                                                                         ((eval t_mod) rtx (* pi 0.5))
                                                                         (+ (getvar "TEXTSIZE") (/ w 2.))
                                                                  )
                                                         )
                                          )
                                          0.0
                                          (strcat "DN"
                                                  "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                                                  (itoa (vla-get-objectid (vlax-ename->vla-object obj)))
                                                  ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%"
                                          )
                            )
                   )
                   (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
                     (setq rtx (+ rtx pi))
                   )
                   (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
                           (list 'attachmentpoint   'height            'drawingdirection
                                 'insertionpoint    'stylename         'layer
                                 'rotation
                                )
                           (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") clay rtx)
                   )
                   (setq out (cons nw_obj out))
            )
          )
          ;;RJP add - pickpoint to flip labels or enter to exit
          (while (setq p (getpoint "\nPick a point to flip labels :"))
            (foreach txt out
              (vla-move txt
                        (vla-get-insertionpoint txt)
                        (vlax-3d-point
                          (polar (setq pt (vlax-get txt 'insertionpoint))
                                 (angle pt (setq pt2 (vlax-curve-getclosestpointto ename pt)))
                                 (* 2. (distance pt pt2))
                          )
                        )
              )
            )
          )
   )
   (princ "\nThis polyline does not have a constant width!")
 )
 (prin1)
)

 

Hi Ronjonp,

 

This seems to work exactly as I described (hope my original description was good enough and this was not just by coincidence)

 

I will test it properly at work on monday and give some feedback. But preliminary testing seems very satisfactory!

 

Big thanks to you again, and am especially thankful that you have provided description in your code so that I can see what you did and how you did it.

ronjonp Grand Master

ronjonp

Posted
Posted

Glad to help :D ...let me know if it does not work as expected.

MarcoW Experienced

MarcoW

Posted
Posted

After I tried the routine (just out of curiousity) I am wondering if following is possible.

 

Say we have a layer called "19mm pipe", so all lines drawn in that layer pipes 19mm. Now i place text beside the line "19mm" or i use a linetype that is explained somewhere in the drawing. Sometimes i place a leader wich is filled out with the desired text "19mm".

 

Is there a way to place a (sort of) leader on that line that direcly shows the diameter?

For the line itself has no diameter, i know. Maybe beause it is a line an it is on a specific layer it can be done.

 

Just curious... and i could use it.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...