Topic: Help with 3 Chord Truncation Please

[scottcd]

I am having a bit of a brain fade :ugly:

I am trying to create a 3 chrord 6 m truncation.

I can pick the 2 lines, create the arc and extract the points for the chords.

But I am having trouble with the direction of the arc and the way the lines are drawn.

Can someone have a quick scan of my code and see where I have got mixed up, or suggest a better way?

Thanks in advance

Scott

Code: [Select]


(defun c:3_chord ()
  (vl-load-com)

  (setvar "osmode" 0) ; set snap off

  (setq old_layer (getvar "clayer")) ; Existing layer

  (setq points nil) ; Set points list to nil

  (setq chord_length 6.0) ; Default Chord Length

  (setq arc_segments 3.0) ; Default number of segments

  (setq line_1 (vlax-ename->vla-object ; Line 1
(car (entsel "\nSelect First (LEFT) Line... "))
       ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (setq Line_2 (vlax-ename->vla-object ; Line 2
(car (entsel "\nSelect Second (RIGHT) Line... "))
       ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq

  (setq int_point (vlax-safearray->list ; Intersection point
    (vlax-variant-value
      (vla-IntersectWith line_1 Line_2 3) ;_ end of vla-IntersectWith - '3' index - extend both lines
    ) ;_ end of vlax-variant-value
  ) ;_ end of vlax-safearray->list
  ) ;_ end of setq

  (setq line_colour (vlax-get-property line_1 'Color)) ; Line Colour

  (if (= line_colour 256)
    (setq line_colour "bylayer")
  ) ;_ end of if
  (setvar "cecolor" line_colour)

  (setq line_layer (vlax-get-property line_1 'layer)) ; Line Layer

  (setvar "clayer" line_layer)

  (setq stpt_line_1 (vlax-curve-getStartPoint line_1)) ; Start and End points of 1st line
  (setq endpt_line_1 (vlax-curve-getEndPoint line_1))

  (setq closest_line_1 (vlax-curve-getClosestPointTo line_1 int_point))
  (setq closest_line_2 (vlax-curve-getClosestPointTo line_2 int_point))

  (setq stpt_line_2 (vlax-curve-getStartPoint line_2)) ; Start and End points of 2nd  line
  (setq endpt_line_2 (vlax-curve-getEndPoint line_2))

  (if (< (distance closest_line_1 stpt_line_1) chord_length)
; Calc new end points from intersection
    (setq sp1 (polar int_point
     (angle int_point endpt_line_1)
     chord_length
      ) ;_ end of polar
    ) ;_ end of setq
    (setq
      sp1 (polar int_point (angle int_point stpt_line_1) chord_length)
    ) ;_ end of setq
  ) ;_ end of if

  (if (< (distance closest_line_2 stpt_line_2) chord_length)
    (setq
      ep1 (polar int_point
(angle int_point endpt_line_2)
chord_length
  ) ;_ end of polar
    ) ;_ end of setq
    (setq ep1 (polar int_point
     (angle int_point stpt_line_2)
     chord_length
      ) ;_ end of polar
    ) ;_ end of setq
  ) ;_ end of if

  (command "arc" sp1 "E" ep1 "Direction" int_point) ; draw the arc

  (setq arcobj (vlax-ename->vla-object (cdr (car (entget (entlast))))))
; get arc object

  (setq Start (vlax-Curve-getStartParam arcobj)) ; get points on arc
  (setq End (vlax-Curve-getEndParam arcobj))
  (setq Start (vlax-Curve-getDistAtParam arcobj Start))
  (setq End (vlax-Curve-getDistAtParam arcobj End))
  (setq arc_Length (- End Start)) ; length of arc

  (setq arc_dist (/ arc_length arc_segments))
  (setq arc_dist_orig arc_dist)


  (while (< arc_dist arc_length)
    (setq
      Points (cons (vlax-curve-GetPointAtDist arcobj arc_Dist) Points)
    ) ;_ end of setq
    (setq arc_dist (+ arc_dist arc_dist_orig))
  ) ;_ end of while

  (cond
    ((and
       (> (car ep1) (car sp1)) ;
       (< (cadr ep1) (cadr ep2))
     ) ;_ end of and
     (progn
       (prompt "\nCond A")
       (setq points (cons sp1 points)) ; add start point
       (setq points (reverse points)) ; reverse points list
       (setq points (cons ep1 points)) ; add end point ot list of points
       (setq points (reverse points))
     ) ;_ end of progn
    )
    ((and
       (> (car ep1) (car sp1)) ;
       (> (cadr ep1) (cadr ep2))
     ) ;_ end of and
     (progn
       (prompt "\nCond B")
       (setq points (reverse points)) ; reverse points list
       (setq points (cons sp1 points)) ; add end point ot list of points
       (setq points (reverse points)) ; reverse points list
       (setq points (cons ep1 points)) ; add start point
     ) ;_ end of progn
    )
    ((and
       (< (car ep1) (car sp1)) ;
       (< (cadr ep1) (cadr ep2))
     ) ;_ end of and
     (progn
       (prompt "\nCond C")
       (setq points (cons sp1 points)) ; add start point
       (setq points (reverse points)) ; reverse points list
       (setq points (cons ep1 points)) ; add end point ot list of points
       (setq points (reverse points))
     ) ;_ end of progn
    )
    ((and
       (< (car ep1) (car sp1)) ;
       (> (cadr ep1) (cadr ep2))
     ) ;_ end of and
     (progn
       (prompt "\nCond D")
       (setq points (reverse points)) ; reverse points list
       (setq points (cons sp1 points)) ; add end point ot list of points
       (setq points (reverse points)) ; reverse points list
       (setq points (cons ep1 points)) ; add start point
     ) ;_ end of progn
    )
  ) ;_ end of cond


  (entdel (entlast)) ; delete arc

  (command "._LINE") ; create chord lines
  (apply 'command points)
  (command "")

  (if (equal closest_line_1 stpt_line_1)
    (vla-put-startpoint line_1 (vlax-3d-point sp1))
  ) ;_ end of if

  (if (equal closest_line_1 endpt_line_1)
    (vla-put-endpoint line_1 (vlax-3d-point sp1))
  ) ;_ end of if

  (if (equal closest_line_2 stpt_line_2)
    (vla-put-startpoint line_2 (vlax-3d-point ep1))
  ) ;_ end of if

  (if (equal closest_line_2 endpt_line_2)
    (vla-put-endpoint line_2 (vlax-3d-point ep1))
  ) ;_ end of if

;;;  (setvar "clayer" "trav")
  (command "line" sp1 int_point ep1 "") ;draw lines for trav
  (setvar "clayer" old_layer)
  (princ)

) ;_ end of defun

;|«Visual LISP© Format Options»
(200 2 80 2 T "end of " 80 9 0 0 nil T T T T)
;*** DO NOT add text below the comment! ***|;

[Code][/code]

[Kerry]

See if this gives you some ideas ..

Code: [Select]

    (SETQ line_1 (VLAX-ENAME->VLA-OBJECT          ; Line 1
                     (CAR (setq pp (ENTSEL "\nSelect First (LEFT) Line... ")))
                 )         
          pt1 (osnap (cadr pp) "nea") ; actual selection point on Line
    )
    (SETQ Line_2 (VLAX-ENAME->VLA-OBJECT          ; Line 2
                     (CAR (setq pp (ENTSEL "\nSelect Second (RIGHT) Line... ")))
                 )         
          pt2 (osnap (cadr pp) "nea") ; actual selection point on Line
    )

[scottcd]

See if this gives you some ideas ..

Code: [Select]

    (SETQ line_1 (VLAX-ENAME->VLA-OBJECT          ; Line 1
                     (CAR (setq pp (ENTSEL "\nSelect First (LEFT) Line... ")))
                 )         
          pt1 (osnap (cadr pp) "nea") ; actual selection point on Line
    )
    (SETQ Line_2 (VLAX-ENAME->VLA-OBJECT          ; Line 2
                     (CAR (setq pp (ENTSEL "\nSelect Second (RIGHT) Line... ")))
                 )         
          pt2 (osnap (cadr pp) "nea") ; actual selection point on Line
    )

I think I am with you...

I can test for the closest end point to the pick point, and it will also give me the direction of the line.

Can you confirm for me that "vlax-Curve-getDistAtParam" returns the point in a clockwise direction, regardless of the way the arc was drawn?

Cheers

Scott

[Kerry]

I can test for the closest end point to the pick point, and it will also give me the direction of the line.

nope, not even that tricky, think about:-

Code: [Select]

(setq
   line_1_angle (angle pt1 int_point)
   line_2_angle (angle pt2 int_point)
)

added:
That way the direction of the lines is irrelevant .. yes ?

[Kerry]

Just to clarify what you want, can you provide a couple of examples in different configurations indicating line_1, line_2 and the arc you want.

What is meant by Left Line and Right line ? ?
Is the arc meant to be similar to a fillet ? ?

[scottcd]

Hi Kerry,

I have attached an image that shows what is happening at the moment.

The order of the points I create on the arc are not in the correct order depending on the order of lines picked and the direction the lines were drawn.

Hope this helps - probably clear as mud

Cheers

Scott

[Kerry]

OK, so the arc will be tangential to the lines ?

Personally, I'd make Line_1 the Right Line to correspond with the arc start side 'cause the arc would then  be counter-clockwise naturally .. but no biggie.

I assume you won't be trimming or extending the lines, so you can forget the line direction completely and just concentrate on the 3 points Pt1, Pt2 and Int_Point ; in fact, once the points are known a reference to the lines themselves is not needed.
The start and end points for the arc are a product of the geometry relationship ... simple from there.

[Kerry]

a rough possible outline
 

Code: [Select]

(defun c:test_3_chord ( )
   
;; save system variables, establish program variables

;; select bounding lines, Right first, then left

;; determine a point pt1 on Line_1

;; determine a point pt2 on Line_2

;; determine point pt0 , the intersection of  Line_1 and Line_2

;; calculate ArcStartPoint 6 units from pt0 in the direction of pt1
   
;; calculate ArcEndPoint 6 units from pt0 in the direction of pt2

;; calculate the enclosed angle pt1, pt0, pt2
   
;; calculate the center of the Arc

;; either
;;;; create the temporary arc and calculate the points for the 3 lines
;;;; or
;;;; calculate the new line points directly   
   
;; generate the lines

   
;; restore system variables
   
)

[VVA]

;; either
;;;; create the temporary arc and calculate the points for the 3 lines

I use this function for traсе an arc

Code: [Select]

; -- Function arcdiv
;Divide or Measurement Arc
; Arguments [Type]:
;      arcobj = vla object of acr [Vla]
;      count  = Positive or a negative number [Int]
;               Positive -  Quantity of segments (Divide)
;               Negative -  Through the specified distance (Measurement)
(defun arcdiv ( arcobj count / S_Par E_Par Rad LSegm le dpar par vx)
  (setq S_Par (vlax-curve-getStartParam arcobj))
  (setq E_Par (vlax-curve-getEndParam arcobj))
  (setq Rad (vla-get-Radius arcobj))
  (setq LSegm (vla-get-ArcLength arcobj))
  (cond ((> count 0)(setq le (/ LSegm count)))
        ((< count 0)(setq le (abs count))
   (if (> le LSegm)(setq le (/ LSegm 2.0))))
        (t nil)
   )
  (setq dpar (* (/ le LSegm)(- E_Par S_Par)) n 0)
  (while (< (setq par (+ (* dpar (setq n (1+ n)))(vlax-curve-getStartParam arcobj)))
    (vlax-curve-getEndParam arcobj)
    )
  (setq vx (append vx (list (vlax-curve-getPointAtParam arcobj par)))));_while
 (setq vx (append (list (vlax-curve-getPointAtParam arcobj S_Par)) vx (list (vlax-curve-getPointAtParam arcobj E_Par)) ))
  )

(defun C:TEST ( / arc vx pt1 pt2)
  (vl-load-com)
  (setq arc_segments 3.0); Default number of segments
  (if (and (setq arc (car(entsel "\nSelect Arc:")))
   (= (cdr(assoc 0 (entget arc))) "ARC")
   )
    (progn
      (setq arc (vlax-ename->vla-object arc))
      (setq vx (arcdiv arc arc_segments))
      (setq pt1 (car vx))
      (foreach pt2 (cdr vx)
(vla-AddLine (vla-ObjectIDToObject (vla-get-ActiveDocument(vlax-get-acad-object))(vla-get-OwnerID arc))
  (vlax-3d-point pt1)
  (vlax-3d-point pt2)
  )
(setq pt1 pt2)
)
       
      )
    )
  (princ)
  )


[CAB]

Offered "As Is". This is a quickie.
Note, select the lines on the side of the intersection you want the arc.

Code: [Select]

(defun c:3c (/        ARCENT   ARC_SEGMENTS      CHORD_LENGTH      L1
             L2       P1       P2       P3       PX       PX1      SP1
             SP2      STEP     TOTDIST  lncolor  lnlayer
            )
  (vl-load-com)
  (setq chord_length 6.0)
  (setq arc_segments 3.0)
  (setq l1 (entsel "\nSelect the first line."))
  (setq l2 (entsel "\nSelect the second line."))
  (if (and l1 l2)
    (progn
      (setq p1 (vlax-curve-getclosestpointto (car l1) (cadr l1))
            l1 (car l1)
            lncolor (cdr (assoc 62 (entget l1)))
            lnlayer (cdr (assoc 8 (entget l1)))
      )
      (or lncolor (setq lncolor 256))
      (setq p3 (vlax-curve-getclosestpointto (car l2) (cadr l2))
            l2 (car l2)
      )
      (setq p2 (inters (vlax-curve-getstartpoint l1)
                       (vlax-curve-getendpoint l1)
                       (vlax-curve-getstartpoint l2)
                       (vlax-curve-getendpoint l2)
               )
      )
      (setq sp1 (polar p2 (angle p2 p1) chord_length))
      (setq sp2 (polar p2 (angle p2 p3) chord_length))
      (command "_.arc" "_non" sp1 "_EN" "_non" sp2 "_Direction" "_non" p2)
      (setq arcent (entlast))
      (setq step    (/ (vlax-curve-getdistatparam
                         arcent
                         (vlax-curve-getendparam arcent)
                       )
                       arc_segments
                    )
            totdist step
      )
      (setq px1 (vlax-curve-getpointatdist arcent totdist))
      (if (> (distance px1 sp1) (distance px1 sp2))
        (setq px sp2)
        (setq px sp1)
      )
      (repeat (fix arc_segments)
        (setq px1 (vlax-curve-getpointatdist arcent totdist))
        (entmake (list (cons 0 "LINE")
                       (cons 62 lncolor)
                       (cons 8 lnlayer)
                       (cons 10 px)
                       (cons 11 px1)))
        (setq totdist (+ totdist step)
              px      px1
        )
      )
      (entdel arcent)
    )
  )
  (princ)
)<edit: change to entmake for the lines.>

[scottcd]

Thanks Cab  & Kerry! 

I have run with your code and made a couple of minor modifications - If the lines don't meet I still need to know the intersection.

Also I trim the original lines to the start of the truncation.

Thanks Kerry for helping with the flow of logic....

Cheers

Scott

Code: [Select]

(defun c:3c (/
     ARCENT
     ARC_SEGMENTS
     CHORD_LENGTH
     L1
     L2
     P1
     P2
     P3
     PX
     PX1
     SP1
     SP2
     STEP
     TOTDIST
     lncolor
     lnlayer
    )
  (vl-load-com)
  (setq chord_length 6.0)
  (setq arc_segments 3.0)
  (setq l1 (entsel "\nSelect the first line."))

  (if l1
    (progn
      (setq sp_l1 (vlax-curve-getstartpoint (car l1)) ; Start Point Line 1
    ep_l1 (vlax-curve-getendpoint (car l1)) ; End Point Line 1
      ) ;_ end of setq
      (grdraw sp_l1 ep_l1 1)
    ) ;_ end of progn
  ) ;_ end of if


  (setq l2 (entsel "\nSelect the second line."))

  (if l2
    (progn
      (setq sp_l2 (vlax-curve-getstartpoint (car l2)) ; Start Point Line 2
    ep_l2 (vlax-curve-getendpoint (car l2)) ; End Point Line 2
      ) ;_ end of setq
      (grdraw sp_l2 ep_l2 1)
    ) ;_ end of progn
  ) ;_ end of if
  (if (and l1 l2)
    (progn
      (setq p1     (vlax-curve-getclosestpointto (car l1) (cadr l1))
    l1     (car l1)
    lncolor (cdr (assoc 62 (entget l1)))
    lnlayer (cdr (assoc 8 (entget l1)))
      ) ;_ end of setq
      (or lncolor (setq lncolor 256))
      (setq p3 (vlax-curve-getclosestpointto (car l2) (cadr l2))
    l2 (car l2)
      ) ;_ end of setq


      (setq line_1 (vlax-ename->vla-object l1))
      (setq Line_2 (vlax-ename->vla-object l2))

      (setq p2 (vlax-safearray->list ; Intersection point
(vlax-variant-value
   (vla-IntersectWith line_1 Line_2 3) ;_ end of vla-IntersectWith - '3' index - extend both lines
) ;_ end of vlax-variant-value
       ) ;_ end of vlax-safearray->list
      ) ;_ end of setq


      (setq sp1 (polar p2 (angle p2 p1) chord_length))
      (setq sp2 (polar p2 (angle p2 p3) chord_length))

      (if (< (distance p2 sp_l1)
     (distance p2 ep_l1)
  ) ;_ end of <
(vla-put-startpoint line_1 (vlax-3d-point sp1))
(vla-put-endpoint line_1 (vlax-3d-point sp1))
      ) ;_ end of if

      (if (< (distance p2 sp_l2)
     (distance p2 ep_l2)
  ) ;_ end of <
(vla-put-startpoint line_2 (vlax-3d-point sp2))
(vla-put-endpoint line_2 (vlax-3d-point sp2))
      ) ;_ end of if

      (command "_.arc" "_non" sp1 "_EN" "_non" sp2 "_Direction" "_non" p2)
      (setq arcent (entlast))
      (setq step    (/ (vlax-curve-getdistatparam
arcent
(vlax-curve-getendparam arcent)
       ) ;_ end of vlax-curve-getdistatparam
       arc_segments
    ) ;_ end of /
    totdist step
      ) ;_ end of setq
      (setq px1 (vlax-curve-getpointatdist arcent totdist))
      (if (> (distance px1 sp1) (distance px1 sp2))
(setq px sp2)
(setq px sp1)
      ) ;_ end of if
      (repeat (fix arc_segments)
(setq px1 (vlax-curve-getpointatdist arcent totdist))
(entmake (list (cons 0 "LINE")
       (cons 62 lncolor)
       (cons 8 lnlayer)
       (cons 10 px)
       (cons 11 px1)
) ;_ end of list
) ;_ end of entmake
(setq totdist (+ totdist step)
      px      px1
) ;_ end of setq
      ) ;_ end of repeat
      (entdel arcent)
    ) ;_ end of progn
  ) ;_ end of if
  (redraw)
  (princ)
) ;_ end of defun