Drawing lines on every outwards polyline node

[PabloS]

Hello:

 

Hope you all are doing well. Here I come with a problem I need to solve but I don't know how to achieve:

 

 

I need to draw small lenght (20/25 cm long) lines with 45 degrees relative angles to polyline sides only on outwards nodes.

 

I've found a way to add a point on every vertex using the next code:

(defun c:apeos (/ _point c el p s typ)
 (defun _point (p) (entmakex (list '(0 . "POINT") '(8 . "POINT") (cons 10 p))))

  (if (and (setq s (ssget '((0 . "*polyline,line,circle")))))
   (foreach pl	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
     (cond ((= "CIRCLE" (setq typ (cdr (assoc 0 (setq el (entget pl))))))
     (_point (cdr (assoc 10 el)))
    )
    ((= "LINE" typ) (_point (cdr (assoc 10 el))) (_point (cdr (assoc 11 el))))
    ((setq p (vlax-get (vlax-ename->vla-object pl) 'coordinates))
     (setq obj (vlax-ename->vla-object pl))
     (setq c (= "LWPOLYLINE" typ))
     (while p
       (_point (if c
		 (list (car p) (cadr p))
		 (list (car p) (cadr p) (caddr p))
	       )
       )
       (if c
	 (setq p (cddr p))
	 (setq p (cdddr p))
       )
     )
    )
     )
   )
 )
 (princ)
)
(vl-load-com)

 

I'm strugglin to add the lines and most difficult only in outwards vertex.

 

Hope somebody can help me here.

 

Regards

[devitg]

@PabloS, please upload your sample.dwg  

 

[PabloS]

Hello @devitg

 

Thanks for your reply!! Here I upload a DWG example.

Regards,

Pablo

EXAMPLE.dwg

Edited February 8 by PabloS

[Steven P]

Not sure if I have time tonight to make something up - looking at something else just now, but if it it was me.... (and there might be better ideas out there)

 

Use VLA-Offset to offset twice, +20 and -20 distance. Call both these lines a name, handy for later.

You might need an error check here that the shorter one is created.

Work out the length or area of each new polyline and delete the shorter one. Should be a routine online to copy and paste.

You should be left with your original and your new line

Use mAssoc function which you should be able to find online to return each vertex of the polyline and with luck the order of the 2 lists of points will match

Loop through the 2 lists of points drawing a line between matching points.

Delete the remaining offset line.

 

Job mostly done, apart from the lines coming off the 90 degree angles (as opposed to the 270 degree angles). I'd perhaps work this out either angle of the new line point and one of the adjacent points on the polyline.

 

 

 

Might come back to this later with some detail, wonder if this is enough to have a go?

 

 

[Steven P]

Try this as a start: 

 

EDITED

This will draw short lines (length about 28) from every corner.. just need to adjust for 0 degree angles as above.

If the selected polyline has a U shape, added a check in case its width is small, reduced offset if so.

Added description to what is happening

 

(defun c:test ( / MyPLine MyEnt PLine1 PLine2 PLine1Dist PLineDist2 MyOffsetL AnOffset )
  (defun mAssoc (key lst /) ;;Subfunction returns a list of dotted pair key values
   (mapcar 'cdr (vl-remove-if-not (function (lambda (item) (= key (car item)))) lst))
  )
  (defun MakeLine (pt1 pt2) ;;Sub function draws a line. Minimum requirements.
    (entmake (list 
      '(0 . "LINE") ;type
      (cons 10 pt1)
      (cons 11 pt2)
    ))
  )

  (setq MyPline (car (entsel "Select Polyline")))  ;;Select an entity
  (setq MyEnt (entget MyPline))                    ;;Entity definition list (DXF)
  (setq MyPLinePoints (mAssoc 10 MyEnt))           ;;List of polyline points
  (setq MyOffsetPoints (list))                     ;;Blank list offset temp. line points
  (setq AnOffset 20)                               ;;Offset distance, X, Y distance for little lines
  (if (= (cdr (assoc 0 MyEnt)) "LWPOLYLINE")       ;;Check entity is a polyline
    (progn
      (while (< (+ (length MyOffsetPoints) 1) (length MyPLinePoints) ) ;;Loop for the case of 'U' shape
        (vl-catch-all-apply 'vla-Offset (LIST (vlax-ename->vla-object MyPline) AnOffset) ) ;;Offset 'out'
        (setq PLine1 (entlast))                    ;;Name the offset line
        (vl-catch-all-apply 'vla-Offset (LIST (vlax-ename->vla-object MyPline) (* AnOffset -1)) ) ;;Offset 'in'
        (setq Pline2 (entlast))                    ;;Name the offset line
        (command "_.area" "_o" PLine1)
        (setq PLine1Dist (getvar "perimeter") )    ;;Length of offset 'out' polyline
        (command "_.area" "_o" PLine2)
        (setq PLine2Dist (getvar "perimeter") )    ;;Length of offset 'in' polyline

        (cond                                      ;;Check the offset lines for outside
          ((equal Pline1 PLine2)                   ;;If they are the same
            (setq MyOffsetL Pline1)
          )
          ((< PLine1Dist Pline2Dist)               ;;If 'in' is longer
            (entdel PLine1)                        ;;Delete 'out'
            (setq MyOffsetL Pline2)
          )
          ((> PLine1Dist Pline2Dist)               ;;If 'out' is longer
            (Entdel PLine2)                        ;;Delete 'in'
            (setq MyOffsetL Pline1)
          )
        ) ; end conds

        (setq MyOffsetPoints (mAssoc 10 (entget MyOffsetL)))  ;;coordinate list of retained offset line
        (entdel MyOffsetL)                         ;;Delete offset line (soonest in case of later errors)
        (setq AnOffset (* AnOffset 0.9))           ;; shrink offset in the case of small 'U'
      )
      (setq acount 0)
      (while (< acount (length MyPlinePoints))     ;;Loop through polyline coordinates
        (if (and (nth acount MyPlinePoints)        ;;Check both lists have a point
                 (nth acount MyOffsetPoints)
            )
          (MakeLine (nth acount MyPlinePoints) (nth acount MyOffsetPoints)) ;;Draw line
        )
        (setq acount (+ acount 1))
      ) ; end while

    ) ; end progn if polyline
    (princ "Polyline not selected")
  )   ; end if polyline
  (princ) ; exit quietly
)

 

 

 

 

A second thing, perhaps go to the other post where you asked the same and reference this thread to avoid double posts  and parallel solutions

Edited February 9 by Steven P

[BIGAL]

There is code out there for internal external angle. Again the issue of CW CCW pline I think may creep in. The ends are easy in a manual sense drag line over near ends gets the two plines  so know which way to draw short lines, the single corner just pick corner get vertices and check in out angle then draw line note at 1/2 angle. No cad at moment.

Edited February 9 by BIGAL

[Steven P]

Try this:

 

It can be adjusted to suit your requirements later.

 

(defun c:test ( / MyPLine MyEnt PLine1 PLine2 PLine1Dist PLineDist2 MyOffsetL AnOffset pt1 pt2 ip AnAngle)
  (defun mAssoc (key lst /) ;;Subfunction returns a list of dotted pair key values
   (mapcar 'cdr (vl-remove-if-not (function (lambda (item) (= key (car item)))) lst))
  )
  (defun MakeLine (pt1 pt2) ;;Sub function draws a line. Minimum requirements.
    (entmake (list 
      '(0 . "LINE") ;type
      (cons 10 pt1)
      (cons 11 pt2)
    ))
  )

;;https://www.thecadforums.com/threads/angle-between-three-points.68457/
  (defun enclAngle( pt1 pt2 ip / dist1 dist2 dist3)
    (setq dist1 (distance pt1 ip)
          dist2 (distance pt2 ip)
          dist3 (distance pt1 pt2)
    );setq
    ;; angle = acos((a^2 + b^2 - c^2) / (2*a*b))
    (acos (/ (- (+ (sqr dist1) (sqr dist2)) (sqr dist3)) (* 2 dist1 dist2)))
  );End Defun enclAngle

  (defun acos( value / )
    (+ (atan (/ (- 0 value) (sqrt (+ (* (- 0 value) value) 1)))) (* 2 (atan 1)) )
  );acos

  (defun sqr(num)
    (* num num)
  )

;;Function:
  (setq MyPline (car (entsel "Select Polyline")))  ;;Select an entity
  (setq MyEnt (entget MyPline))                    ;;Entity definition list (DXF)
  (setq MyPLinePoints (mAssoc 10 MyEnt))           ;;List of polyline points
  (setq MyOffsetPoints (list))                     ;;Blank list offset temp. line points
  (setq AnOffset 20)                               ;;Offset distance, X, Y distance for little lines
  (if (= (cdr (assoc 0 MyEnt)) "LWPOLYLINE")       ;;Check entity is a polyline
    (progn
      (while (< (+ (length MyOffsetPoints) 1) (length MyPLinePoints) ) ;;Loop for the case of 'U' shape
        (vl-catch-all-apply 'vla-Offset (LIST (vlax-ename->vla-object MyPline) AnOffset) ) ;;Offset 'out'
        (setq PLine1 (entlast))                    ;;Name the offset line
        (vl-catch-all-apply 'vla-Offset (LIST (vlax-ename->vla-object MyPline) (* AnOffset -1)) ) ;;Offset 'in'
        (setq Pline2 (entlast))                    ;;Name the offset line
        (command "_.area" "_o" PLine1)
        (setq PLine1Dist (getvar "perimeter") )    ;;Length of offset 'out' polyline
        (command "_.area" "_o" PLine2)
        (setq PLine2Dist (getvar "perimeter") )    ;;Length of offset 'in' polyline

        (cond                                      ;;Check the offset lines for outside
          ((equal Pline1 PLine2)                   ;;If they are the same
            (setq MyOffsetL Pline1)
          )
          ((< PLine1Dist Pline2Dist)               ;;If 'in' is longer
            (entdel PLine1)                        ;;Delete 'out'
            (setq MyOffsetL Pline2)
          )
          ((> PLine1Dist Pline2Dist)               ;;If 'out' is longer
            (Entdel PLine2)                        ;;Delete 'in'
            (setq MyOffsetL Pline1)
          )
        ) ; end conds

        (setq MyOffsetPoints (mAssoc 10 (entget MyOffsetL)))  ;;coordinate list of retained offset line
        (entdel MyOffsetL)                         ;;Delete offset line (soonest in case of later errors)
        (setq AnOffset (* AnOffset 0.9))           ;; shrink offset in the case of small 'U'
      )
      (setq acount 0)
      (while (< acount (length MyPlinePoints))     ;;Loop through polyline coordinates

        (if (and (nth acount MyPlinePoints)        ;;Check both lists have points
                 (nth acount MyOffsetPoints)
            )
          (progn
            (if (= acount 0)                       ;;work out the (nth-1) point
              (if (equal (car MyPlinePoints) (last MyPlinePoints) )
                (setq pt1 (cadr (reverse MyPlinePoints)) )
                (setq pt1 (last MyPlinePoints) )
              )
              (setq pt1 (nth (- acount 1) MyPlinePoints))
            ) ; end if acount = 0
            (setq pt2 (nth acount MyOffsetPoints))
            (setq ip (nth acount MyPlinePoints))

            (setq MyAngle (/ ( * (enclAngle pt1 pt2 ip) 180 ) pi) ) ;;Angle short new line and original
            (if (and (< 45.001 MyAngle)            ;; UP to 90 degee angles. With small fudge factor
                  (> 314.999 MyAngle)              ;; UP to 90 degee angles. With small fudge factor
                ) ; end and
              (MakeLine (nth acount MyPlinePoints) (nth acount MyOffsetPoints)) ;;Draw line
            ) ; end if
          )
        )
        (setq acount (+ acount 1))
      ) ; end while

    ) ; end progn if polyline
    (princ "Polyline not selected")
  )   ; end if polyline
  (princ) ; exit quietly
)

 

Edited February 9 by Steven P

[devitg]

@PabloS test it 

 

 

patas.LSP

[ymg3]

Here is my take, with visual lisp.
Corrected the code to work for cw and ccw poly, and attached the file.

 

;;                                                                 ;;
;; markpl      by ymg                                              ;;
;;                                                                 ;;
;; From a selection set of polyline the app will                   ;;
;; draw line 50 units long to the outside of each concave angle    ;;
;; of the closed polylines in the selection set.                   ;;
;;                                                                 ;;
;; Requires iscw_p by Lee Mac                                      ;;
;;                                                                 ;;

(defun c:markpl (/ ss j pl ol al d i cw)
  (setq ss (ssget '((0 . "*POLYLINE"))))
  (setq j 0 pl nil ol nil al nil d 75)
  (repeat (sslength ss)
    (setq en (ssname ss j))
    (if (vlax-curve-isclosed en)
       (progn
         (repeat (setq i (fix (1+ (vlax-curve-getEndParam en))))
           (setq pl (cons (trans (vlax-curve-getPointAtParam en (setq i (1- i))) 0 1) pl)		 
	         ol (cons (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en (vlax-curve-getParamAtPoint en (car pl)))) ol)
	   )
	 )
         (setq cw (iscw_p pl))
	 (setq	al (mapcar '(lambda (a)
		      (if cw (setq a (* a -1)))	       
	    	      (while (or (< a 0) (> a (* 2 pi)))
	   		(setq a (rem (+ a (* 2 pi)) (* 2 pi)))
	   	      )
	   	      a
	   	    )
		   (mapcar '- (cdr ol) ol)
	           )
	        al (cons (last al) (reverse (cdr (reverse al))))
         )
	 (mapcar '(lambda (a o p) (if (< a pi)
				     (entmakex (list '(0 . "LINE") (cons 10 p )
						      (cons 11 (polar p  (if cw (+ (* pi 0.5) o (* a 0.5)) (+ pi o (* a 0.5))) d))
						)
				     )
				   )
		  )
		  al ol pl
	 )
       )       
    )    
    (setq j (1+ j) al nil pl nil ol nil  )	    
  )
)



;;                                                                 ;;
;; iscw_p - Lee Mac                                                ;;
;; Returns T if the point list is clockwise oriented               ;;
;; http://www.lee-mac.com/mathematicalfunctions.html               ;;
;;                                                                 ;;

(defun iscw_p (lst)
  (minusp
    (apply '+
	   (mapcar
	     (function
	       (lambda (a b)
		 (- (* (car b) (cadr a)) (* (car a) (cadr b)))
	       )
	     )
	     lst
	     (cons (last lst) lst)
	   )
    )
  )
)

 

markpl.lsp

Edited April 6 by ymg3
typo