Topic: Arrow head middle of pline, bug?

[T.Willey]

Okay so the code I have works if you:
a - Pick the direction going the same as the polyline, no matter the width of any segment
b - pick the direction going the opposite direction of the polyline with a constant width
c - pick the direction going the opposite direction, with the width of the segment pick equal to 0

If the segment is not 0, then it will not update correctly, and I can't seem to find the reason why.  Here is the code, and a pic to show what I'm talking about (all polylines go clockwise, drawn with the rectangle command picking upper left to lower right).  Guess I should explain that in the pic, the upper right box is the one that is not working.  The upper segment should look the same as the one to the left, except the arrow head facing the other direction.

Thanks in advance.

Code: [Select]

(defun c:Test (/ Sel Pt Obj CoordList cnt ParmPt cnt2 Ang tmpPt1 tmpPt2 Pt2 ArLen ArWidRatio ArAng tmpPt3
    OldOs WidFac StWid EndWid ActDoc)
    ; Add an arrow head in a polyline
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (setq OldOs (getvar 'OsMode))
    (if
        (and
            (setq Sel (entsel "\n Select polyline near where new vertex will be added: "))
            (setq Obj (vlax-ename->vla-object (car Sel)))
            (= (vla-get-ObjectName Obj) "AcDbPolyline")
            (setq Pt (trans (vlax-curve-getClosestPointTo Obj (trans (cadr Sel) 1 0)) 0 (car Sel)))
            (setvar 'OsMode 512)
            (setq Pt2 (getpoint Pt "\n Direction of arrow and length of arrow: "))
            (setq ArLen (distance Pt Pt2))
            (setq ArWidRatio (getdist "\n Enter width of polyline to width of arrow ratio: "))
            (setq ArAng (angle Pt Pt2))
            (setq CoordList (vlax-get Obj 'Coordinates))
        )
        (progn
            (setq cnt 0)
            (setq ParmPt 1)
            (while (< (1+ cnt) (length CoordList))
                (setq cnt2
                    (if (>= (setq cnt2 (+ 2 cnt)) (length CoordList))
                        (- cnt2 (length CoordList))
                        cnt2
                    )
                )
                (setq Ang
                    (angle
                        (setq tmpPt1
                            (list
                                (nth cnt CoordList)
                                (nth (1+ cnt) CoordList)
                            )
                        )
                        (setq tmpPt2
                            (list
                                (nth cnt2 CoordList)
                                (nth (1+ cnt2) CoordList)
                            )
                        )
                    )
                )
                (if
                    (or
                        (equal (angle Pt tmpPt1) Ang 0.000001)
                        (equal (angle Pt tmpPt2) Ang 0.000001)
                    )
                    (setq cnt (length CoordList))
                    (progn
                        (setq ParmPt (1+ ParmPt))
                        (setq cnt (+ 2 cnt))
                    )
                )
            )
            (setq tmpPt3 (polar Pt ArAng ArLen))
            (if
                (vl-catch-all-error-p
                    (setq StWid (vl-catch-all-apply 'vla-get-ConstantWidth (list Obj)))
                )
                (vla-GetWidth Obj (1- ParmPt) 'StWid 'EndWid)
                (setq EndWid StWid)
            )
            (setq WidFac
                (if (zerop StWid)
                    1.0
                    StWid
                )
            )
            (if
                (<
                    (distance tmpPt1 Pt)
                    (distance tmpPt1 tmpPt3)
                )
                (progn
                    (vlax-invoke Obj 'AddVertex ParmPt (list (car Pt) (cadr Pt)))
                    (vlax-invoke Obj 'AddVertex (1+ ParmPt) (list (car tmpPt3) (cadr tmpPt3)))
                    (vlax-invoke Obj 'SetWidth ParmPt (+ WidFac (* WidFac ArWidRatio)) 0.0)
                )
                (progn
                    (vlax-invoke Obj 'AddVertex ParmPt (list (car tmpPt3) (cadr tmpPt3)))
                    (vlax-invoke Obj 'AddVertex (1+ ParmPt) (list (car Pt) (cadr Pt)))
                    (vlax-invoke Obj 'SetWidth ParmPt 0.0 (+ WidFac (* WidFac ArWidRatio)))
                )
            )
            (vlax-invoke Obj 'SetWidth (1- ParmPt) StWid StWid)
            (vlax-invoke Obj 'SetWidth (1+ ParmPt) StWid StWid)
        )
    )
    (setvar 'OsMode OldOs)
    (vla-EndUndoMark ActDoc)
    (princ)
)


[CAB]

I had a different take on it & only got this far.
Out of gas

I'll try again tomorrow if you still need it.

Code: [Select]

;; Add an arrow head in a polyline
(defun c:Test (/ ActDoc OldOs Sel Obj pt pt2 ArLen ArWidRatio par@pt0 par@pt1 par@pt2
               sw ew nw WidFac w1 w2 tmp)
    (vl-load-com)
    ;;  return a 2D Point
    (defun 2d (pt)
      (list (car pt)(cadr pt))
    )

    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (setq OldOs (getvar 'OsMode))
    (if
        (and
            (setq Sel (entsel "\n Select polyline near where new vertex will be added: "))
            (setq Obj (vlax-ename->vla-object (car Sel)))
            (= (vla-get-ObjectName Obj) "AcDbPolyline")
            (setq pt (vlax-curve-getclosestpointto (car Sel) (trans (cadr Sel) 1 0))) ; WCS
            ;(null (command "point" "non" (trans pt 0 1)))
           
            (setvar 'OsMode 512)
            (setq Pt2 (getpoint (trans Pt 0 1) "\n Direction of arrow and length of arrow: "))
            (setq pt2 (vlax-curve-getclosestpointto (car Sel) (trans pt2 1 0)))
            ;(null (command "point" "non" (trans pt2 0 1)))
            (setq ArLen (distance Pt Pt2))
            (setq ArWidRatio (getdist "\n Enter width of polyline to width of arrow ratio: "))
        )
        (progn
          ;;=======================================================
          (setq par@pt1 (vlax-curve-getparamatpoint obj (2d pt)))
          (setq par@pt2 (vlax-curve-getparamatpoint obj (2d pt2)))
          (vla-getwidth obj (fix (min par@pt1 par@pt2)) 'sw 'ew)
          (if (equal sw ew 0.0001) ; update pline width
            (setq nw sw)
            ;; width is a taper
            (setq nw (* (+ sw ew) (rem (min par@pt1 par@pt2) 1)))
          )
          (setq WidFac nw)
         
          (vlax-invoke Obj 'AddVertex (fix (1+ par@pt1)) (2d pt))
          (setq par@pt2 (vlax-curve-getparamatpoint obj (2d pt2)))
          (vlax-invoke Obj 'AddVertex (fix (1+ par@pt2)) (2d pt2))
          (setq par@pt1 (vlax-curve-getparamatpoint obj (2d pt)))
          (setq par@pt2 (vlax-curve-getparamatpoint obj (2d pt2)))
         
          (setq w1 (+ WidFac (* WidFac ArWidRatio))
                w2 0.0
                par@pt0 (fix (min par@pt1 par@pt2)))
          (if (> par@pt1 par@pt2)
            (setq tmp w1 w1 w2 w2 tmp)
          )
          (vla-setwidth obj par@pt0 w1 w2)
          (vla-setwidth obj (1+ par@pt0) nw ew)
          (vla-setwidth obj (1- par@pt0) sw nw)
          (princ)
        )
    )
    (setvar 'OsMode OldOs)
    (vla-EndUndoMark ActDoc)
    (princ)
)PS There may be a bug in the pline? I've gotten some unexplained results too.

<edit: cleaned the code>

[CAB]

Looking at the problem this AM it does appear to be a bug in ACAD.
I created this pline from scratch and the problem persist.
The third segment should display at 2 units wide at start and end but displays at zero start & 2 end.

Code: [Select]

Select entity to list.((-1 . <Entity name: 1cb8cd0>) (0 . "LWPOLYLINE") (330 .
<Entity name: 1cb2810>) (5 . "46B2A") (100 . "AcDbEntity") (67 . 0) (410 .
"Model") (8 . "0") (100 . "AcDbPolyline") (90 . 6) (70 . 0) (38 . 0.0) (39 .
0.0) (10 493.545 683.855) (40 . 2.0) (41 . 2.0) (42 . 0.0) (10 461.651 683.855)
(40 . 6.0) (41 . 0.0) (42 . 0.0) (10 435.845 683.855) (40 . 2.0) (41 . 2.0) (42
. 0.0) (10 402.792 683.855) (40 . 0.0) (41 . 6.0) (42 . 0.0) (10 382.785
683.855) (40 . 2.0) (41 . 2.0) (42 . 0.0) (10 347.992 683.855) (40 . 0.0) (41 .
0.0) (42 . 0.0) (210 0.0 0.0 1.0))

[T.Willey]

Thanks Alan for the confirmation.  I will send a bug report this afternoon, as I have some work that needs to be done by then.  Maybe I will see if I can get it to look right through command methods first, and if it still looks wrong, then I will send a bug report.

[CAB]

I did it by COMMAND with the widths & then created a pline with 6 vertex and used PEDIT to add the widths.
Both methods failed in ACAD2k.

Code: [Select]

Command: _pline
Specify start point:
Current line-width is 0'-0"
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:  <Ortho on> W

Specify starting width <0'-0">: 2

Specify ending width <0'-2">:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]: '_.zoom _e
** Requires a regen, cannot be transparent.

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]: W

Specify starting width <0'-2">: 6

Specify ending width <0'-6">: 0

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]: W

Specify starting width <0'-0">: 2

Specify ending width <0'-2">:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]: W

Specify starting width <0'-2">: 0

Specify ending width <0'-0">: 6

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]: W

Specify starting width <0'-6">: 2

Specify ending width <0'-2">:

Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:
Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:

[T.Willey]

Thanks Alan.  I guess it is a bug then, and should be reported.  I will try and do that later today.

[T.Willey]

Okay, so I have never done this before.  How do I report a bug in the software?  Thanks.

I found the web site by googleing "autocad bug report", and it has been filed.

[T.Willey]

Thanks for posting your code Alan.  I like it, and I will see what I can learn from it.  I still don't use the vlax-curve..... very much, but this seems like a good place to try them out. 

[T.Willey]

Here is the one I did based off what Alan posted.  Mine doesn't take into account a segment with a taper, but it does make sure that the two picked points are on the same segment.

Thanks Alan for posting the way of the vlax-curve-...  It seems the right way to go with this code.  Now to wait until Acad updates there product so that it can be used.   

Code: [Select]

(defun c:Test (/ ActDoc OldOs Sel Obj Pt Pt2 ArLen ArWid ParamPt StWid EndWid NewWid ParamPt2)
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (setq OldOs (getvar 'OsMode))
    (if
        (and
            (setq Sel (entsel "\n Select polyline where fat end of arrow goes: "))
            (setq Obj (vlax-ename->vla-object (car Sel)))
            (= (vla-get-ObjectName Obj) "AcDbPolyline")
            (setq Pt (vlax-curve-getClosestPointTo Obj (trans (cadr Sel) 1 0)))
            (setvar 'OsMode 512)
            (setq Pt2 (getpoint (cadr Sel) "\n Select arrow direction and length: "))
            (setq Pt2 (trans Pt2 1 0))
            (setq ParamPt (fix (vlax-curve-getParamAtPoint Obj Pt)))
            (equal ParamPt (fix (vlax-curve-getParamAtPoint Obj Pt2)) 0.1)
            (setq ArLen (distance Pt Pt2))
            (setq ArWid (getdist "\n Enter width ratio of arrow: "))
        )
        (progn
            (vla-GetWidth Obj ParamPt 'StWid 'EndWid)
            (setq NewWid
                (if (equal StWid 0 0.0001)
                    ArWid
                    (+ StWid (* StWid ArWid))
                )
            )
            (setq Pt (trans Pt 0 (vlax-get Obj 'Normal)))
            (vlax-invoke Obj 'AddVertex (1+ ParamPt) (list (car Pt) (cadr Pt)))
            (setq ParamPt2 (fix (vlax-curve-getParamAtPoint Obj Pt2)))
            (setq Pt2 (trans Pt2 0 (vlax-get Obj 'Normal)))
            (vlax-invoke Obj 'AddVertex (1+ ParamPt2) (list (car Pt2) (cadr Pt2)))
            (if (equal ParamPt ParamPt2)
                (progn
                    (vla-SetWidth Obj (1+ ParamPt2) 0.0 NewWid)
                    (vla-SetWidth Obj (+ ParamPt2 2) StWid EndWid)
                )
                (progn
                    (vla-SetWidth Obj ParamPt2 NewWid 0.0)
                    (vla-SetWidth Obj (1+ ParamPt2) StWid EndWid)
                )
            )
        )
    )
    (setvar 'OsMode OldOs)
    (vla-EndUndoMark ActDoc)
    (princ)
)