NEED A LISP

[inaamazmi]

I need a lisp that can create point on the intersection of diagonal of quadilateral.

[paullimapa]

answer found in this thread: 

Solved: Re: lisp - getpoint geometric center of last entity - Autodesk Community - AutoCAD

(vl-load-com)

(osnap (vlax-curve-getStartPoint (car(entsel))) "gcen")

[-didier-]

Bonjour @paullimapa 

Pardon not to confirm, but the geometric center is not the point sought by inaamazmi 

Bonjour @inaamazmi 

What do you need exactly ?

1. Only the point in a variable
2. Drawing a symbol at this point (a little circle, for example)
3. Drawing the two lines

Amicalement

[-didier-]

@inaamazmi 

the 1 is already done, 2 and 3 are waiting for your answer.

Amicalement

[paullimapa]

try this code:

; getintersect function returns the intersection point drawing the diagonals of a given closed Quadrilateral Pline
; (getintersect)
; <select closed quad pline>
; Draws Lines connecting opposing corners
; Returns point of intersection
(defun getintersect (/ LM:intersections cdrs obj1 obj2 objvlst)
  (vl-load-com)
;; Intersections Between Object Lists  -  Lee Mac
;; Returns a list of all points of intersection between objects in two lists of VLA-Objects.
;; ol1,ol2 - [lst] Lists of VLA-Objects
;; http://lee-mac.com/intersectionfunctions.html
;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)
  
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-of-vertices-of-a-polyline/td-p/775742
;;;(cdrs 10 (entget (car (entsel "\nSelect a polyline: "))))
;;;returns something like this:
;;;((259.943 -252.219) (214.182 -140.305) (254.223 -92.925) (215.0 -21.0386)(253.406 41.8621) (215.817 112.115))
;;;Michal Puckett
(defun cdrs (key lst / pair rtn)
 (while (setq pair (assoc key lst))
  (setq rtn (cons (cdr pair) rtn)
        lst (cdr (member pair lst))
  )
 )
 (reverse rtn)
)
    (princ "\nSelect Closed Pline Quadrilateral: ")(princ) 
    (if 
     (and
      (setq obj (ssget "_+.:E:S" '((-4 . "<AND") (0 . "LWPOLYLINE")(-4 . "<OR")(70 . 1)(70 . 129)(-4 . "OR>")(-4 . "AND>"))))
      (= 4 (length (setq objvlst (cdrs 10 (entget (setq obj (ssname obj 0))))))) ; get pline coordinates
     )
     (progn
;        (command"_.LINE"(nth 0 objvlst)(nth 2 objvlst) "")
        (entmake (list '(0 . "LINE") (cons 10 (nth 0 objvlst)) (cons 11 (nth 2 objvlst))))
        (setq obj1 (entlast))
;        (command"_.LINE"(nth 1 objvlst)(nth 3 objvlst) "")
        (entmake (list '(0 . "LINE") (cons 10 (nth 1 objvlst)) (cons 11 (nth 3 objvlst))))
        (setq obj2 (entlast))
        (LM:intersections (vlax-ename->vla-object obj1) (vlax-ename->vla-object obj2) acextendnone)      
      )
      (progn
        (princ"\nNo Valid Closed Pline Quadrilateral Selected.")(princ)
      )
    ) ; if
)(princ)

[Sea-Haven · Accepted solution]

Maybe the real simple version

(defun c:pmid ( / plent co-ord pt)
(setq plent (entsel "\nPick Object "))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))
(setq pt (inters (nth 0 co-ord)  (nth 2 co-ord)(nth 1 co-ord)(nth 3 co-ord)))
(command "point" pt)
(setvar 'pdmode 34)
)
(c:pmid)

[calderg1000 · Accepted solution]

Regards @inaamazmi 

Try this code. It also works when the point of intersection is located on the outside of the quadrilateral. Draw the diagonals to obtain the point of intersection, but for this case it has been considered to eliminate them.

(defun c:pint (/ spm s prt i lpt l1 l1n l2 l2n pins)
  (setq	spm (vla-get-modelspace
	      (vla-get-activedocument (vlax-get-acad-object))
	    )
	s   (car (entsel "\nselect Quadrilateral Polyline: "))
	prt (vlax-curve-getendparam s)
  )
  (repeat (setq i (fix prt))
    (setq pt  (vlax-curve-getpointatparam s (setq i (1- i)))
	  lpt (cons pt lpt)
    )
  )
  (setq	l1  (vla-addline
	      spm
	      (vlax-3d-point (nth 0 lpt))
	      (vlax-3d-point (nth 2 lpt))
	    )
	l1n (entlast)
  )
  (setq	l2   (vla-addline
	       spm
	       (vlax-3d-point (nth 1 lpt))
	       (vlax-3d-point (nth 3 lpt))
	     )
	l2n  (entlast)
	pins (vla-intersectwith l1 l2 acExtendboth)
  )
  (vla-addpoint spm pins)
 ;_Optional
  (entdel l1n)
  (entdel l2n)
  ;_
  (princ)
)

[inaamazmi]

thank you its working fine