Lisp for Mid line for arcs automatically.

[land]

Hello everyone, I need help to make these lines by a lisp by one .

 

 

 

[Steven P]

You could look at finding out the end points and centre of the arc, something like this: should put a point at the start point, end point and centre of an arc.

 

;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/put-a-point-at-each-end-of-an-arc/td-p/3268078

(defun c:test (/ ss i data ctr rad)
  (if (setq ss (ssget '((0 . "ARC"))))
    (repeat (setq i (sslength ss))
      (setq data (entget (ssname ss (setq i (1- i))))
            ctr  (cdr (assoc 10 data))
            rad  (cdr (assoc 40 data))
      )
      (entmake (list '(0 . "POINT") (cons 10 (polar ctr (cdr (assoc 50 data)) rad)))) ; end a
      (entmake (list '(0 . "POINT") (cons 10 (polar ctr (cdr (assoc 51 data)) rad)))) ; end b

(entmake (list '(0 . "POINT") (assoc 10 data))) ; arc midpoint

    )
  )
  (princ)
)

 

Change the entmake lines so that it won't create points

 

Something like this will get the midpoint of 2 points:

 

;;https://www.cadtutor.net/forum/topic/2146-midpoint-between-two-points/

;; Returns the middle of two points
(defun mid-pt (p1 p2)
 (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) )
)

 

and of course the 2 end points can be found using the first example  (polar ctr (cdr (assoc 50 data)) rad))

 

then you can just draw a line however you like between this midpoint and the arc midpoint (variable ctr from the first example)

 

[Isaac26a]

Not sure but maybe this can help

[land]

thank you for this lisp but i need to select all acrs by one time 

[Tharwat]

13 minutes ago, land said:

thank you for this lisp but i need to select all acrs by one time 

Upload your drawing to take a close look.

[Steven P]

Have a look at what I posted, the information should all be there - but you might need to do some thinking to make it work - which is of course a great way to learn......

 

I think though the mid point I gave above is the centre of the arc and not the middle of the line, This will be better if you can work out how to put it all together:

 

(defun objectMidpoint (MyEnt / ) ; MyEnt is entity name from say (ssname n) function
  (setq object (vlax-ename->vla-object (car (Entsel))))

;;https://www.thecadforums.com/threads/find-the-midpoint-of-an-arc.29507/
;;(defun objectMidpoint (object)
  (vlax-curve-getpointatparam
    object
    (/
      (+ (vlax-curve-getstartparam object)
      (vlax-curve-getendparam object) )
      2.0
    )
  )
)

 

 

 

[Isaac26a]

As long as all the entities are Arcs this will work

;;; c2mpts Line from Midpoint of chords to Midpoint of arcs
;;; 20230618 Isaac A.
;;; https://www.cadtutor.net/forum/topic/77751-lisp-for-mid-line-for-arcs-automatically/
(vl-load-com)
(defun c:c2mpts (/ a b c ct d e oe l oo s ve)
   (setq oe (getvar 'cmdecho)
         oo (getvar 'osmode)
   )
   (setvar 'cmdecho 0)
   (vl-cmdf "_.undo" "_begin")
   (setvar 'osmode 37)
   (princ "\nProgram to create a line from midpoint of chord to midpoint of an arc ")
   (princ "\nSelect the arc elements")
   (setq s (ssget ":L" '((0 . "ARC") )))
   (setq ct 0
          l (sslength s))
   (while (< ct l)
      (setq e  (cdar (entget (ssname s ct)))
            ve (vlax-ename->vla-object   e)
            a  (vlax-curve-getStartPoint ve)
            b  (vlax-curve-getEndPoint   ve)
            c  (ia:midp a b)
            d  (if (= (cdr (assoc 0 (entget e))) "ARC")
                  (vlax-curve-getPointAtDist ve (* 0.5 (vla-get-ArcLength ve)))
                  (vlax-curve-getPointAtDist ve (* 0.5 (vla-get-length ve)))
               )
      )
      (vl-cmdf "_.line" "_non" c "_non" d "") 
      (setq ct (1+ ct))
   )
   (setvar 'osmode oo)
   (setvar 'cmdecho oe)
   (vl-cmdf "_.undo" "_end")
   (princ "\n")
   (princ)
)

;;; ia:midp
;;; Returns the midpoint of 2 given points
(defun ia:midp (a b)
  (mapcar '* (mapcar '+ a b) '(0.5 0.5 0.5))
)

 

[Tsuky]

This for bulge of Lwpolyline or arc?

(vl-load-com)
(defun make_line (dxf / lst_dxf)
  (setq
    lst_dxf
    (list
      (cons 0 "LINE")
      (cons 100 "AcDbEntity")
      (assoc 67 dxf)
      (assoc 410 dxf)
      (cons 8 (getvar "CLAYER"))
      (cons 100 "AcDbLine")
      (cons 10 pt_mid)
      (cons 11 pt_mid-vtx)
      (assoc 210 dxf)
    )
  )
  (foreach n '(6 39 48 62 370 420)
    (if (assoc n dxf)
      (setq lst_dxf (append lst_dxf (list (assoc n dxf))))
    )
  )
  (entmake lst_dxf)
)
(defun c:arrow ( / ss n ename obj dxf_ent dxf_210 pr seg_bulge pt_first pt_snd pt_mid-vtx pt_mid)
  (princ "\nSelect polylines or arcs ")
  (while (null (setq ss (ssget '((0 . "LWPOLYLINE,ARC"))))))
  (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (repeat (setq n (sslength ss))
    (setq
      ename (ssname ss (setq n (1- n)))
      obj (vlax-ename->vla-object ename)
      dxf_ent (entget ename)
      dxf_210 (cdr (assoc 210 dxf_ent))
      pr -1
    )
    (cond
      ((eq (cdr (assoc 0 dxf_ent)) "ARC")
        (setq
          pt_mid-vtx (vlax-curve-getPointAtParam obj (* (+ (vlax-curve-getStartParam obj) (vlax-curve-getEndParam obj)) 0.5))
          pt_mid (mapcar '* (mapcar '+ (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj)) '(0.5 0.5 0.5))
        )
        (make_line dxf_ent)
      )
      (T
        (repeat (fix (vlax-curve-getEndParam ename))
          (setq seg_bulge (vla-GetBulge obj (setq pr (1+ pr))))
          (cond
            ((not (zerop seg_bulge))
              (setq
                pt_first (trans (vlax-curve-GetPointAtParam ename pr) 0 dxf_210)
                pt_snd (trans (vlax-curve-GetPointAtParam ename (1+ pr)) 0 dxf_210)
                pt_mid-vtx (trans (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) 0 dxf_210)
                pt_mid (mapcar '* (mapcar '+ pt_first pt_snd) '(0.5 0.5 0.5))
              )
              (make_line dxf_ent)
            )
          )
        )
      )
    )
  )
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (prin1)
)

 

[land]

thats my file sample

arcs.dwg

[Tharwat]

Here you go, please try it and let me know.

(defun c:Test (/ int sel ent )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect arcs to create pivot lines to them : ")
       (setq int -1 sel (ssget '((0 . "ARC"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (entmake (list '(0 . "LINE")
                        (cons 10 (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent)) 2.0)))
                        (cons 11 (mapcar (function (lambda (j k) (/ (+ j k) 2.0)))
                                         (vlax-curve-getstartpoint ent)
                                         (vlax-curve-getendpoint ent)
                                         )
                              )
                        )
                  )
         )
       )
  (princ)
  ) (vl-load-com)

 

[Steven P]

This example is using the examples I posted above as a basis (see references above for links):

 

(defun c:test (/ ss i data ctr rad StartPr EndPt CtrPt object)
  (if (setq ss (ssget '((0 . "ARC")))) ; select only arcs
    (repeat (setq i (sslength ss)) ; repeat for each arc selected
      (setq data (entget (ssname ss (setq i (1- i)))) ; entity name
            ctr  (cdr (assoc 10 data)) ; centre point of arc
            rad  (cdr (assoc 40 data)) ; radius of arc
            StartPt (polar ctr (cdr (assoc 50 data)) rad)) ; start of arc line
            EndPt   (polar ctr (cdr (assoc 51 data)) rad)) ; end of arc line
            CtrPt (mapcar '/ (mapcar '+ StartPt EndPt) '(2 2 2))) ; mid point of arc chord
            object (vlax-ename->vla-object (ssname ss i))) ; vla- object name of arc entity
            MidPt (vlax-curve-getpointatparam object
             (/ (+ (vlax-curve-getstartparam object) (vlax-curve-getendparam object) ) 2.0 ) 
            )) ; mid point of arc curve
      ) ; end setq
      (command "line" MidPt CtrPt "") ; draw line
    ) ; end repeat
  ) ; end if
  (princ)
)

 

[devitg]

7 hours ago, land said:

thats my file sample

arcs.dwg 86.88 kB · 4 downloads

@land

 

My way to skin the fish.

 

  

 

 

 

 

 

arcs-chords+arrow.dwg make-arrows-@-arcs.LSP

[land]

Worked well thank you

 

 

 

On 6/19/2023 at 10:59 AM, Tharwat said:

(defun c:Test (/ int sel ent )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect arcs to create pivot lines to them : ")
       (setq int -1 sel (ssget '((0 . "ARC"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (entmake (list '(0 . "LINE")
                        (cons 10 (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent)) 2.0)))
                        (cons 11 (mapcar (function (lambda (j k) (/ (+ j k) 2.0)))
                                         (vlax-curve-getstartpoint ent)
                                         (vlax-curve-getendpoint ent)
                                         )
                              )
                        )
                  )
         )
       )
  (princ)
  ) (vl-load-com)

 

 

[Tharwat]

2 hours ago, land said:

Worked well thank you

Cool, you are welcome anytime.