Topic: How to get all parameters at the self intersection of a curve?

[chlh_jd]

my new version , include get self-intersection

Code: [Select]

(defun c:test  (/ en ips)
  (setq en (ssname (ssget ":E:S" '((0 . "SPLINE"))) 0))
  (setq ips (ss:spline:getcrossparams en 1e-8))
  (if ips
    (foreach ip ips
      (entmake (list (cons 0 "POINT")
     (cons 10 (car ip))
     (cons 8 "Temp")
     (cons 62 1)))
      (entmake
(list (cons 0 "LINE")
      (cons 10 '(0 0 0))
      (cons 11 (vlax-curve-getpointatparam en (cadr ip)))
      (cons 8 "Temp")
      (cons 62 1)
      ))
      (entmake
(list (cons 0 "LINE")
      (cons 10 '(0 0 0))
      (cons 11 (vlax-curve-getpointatparam en (caddr ip)))
      (cons 8 "Temp")
      (cons 62 2)
      ))
      (princ (strcat "\nFirst param = "
     (rtos (cadr ip) 2 6)
     " ; Second param = "
     (rtos (caddr ip) 2 6)
     " ;;")))
    )
  (princ)
  )
;;;

(defun ss:spline:getcrossparams (en acc / _oce l l1 ip ips p0 p1 p2 p3)
  ;;by GSLS(SS) 2012-8-17
  (defun getparam  (en l acc / pal paf pas pf ps)
    (setq pal (mapcar (function (lambda (x)
  (vlax-curve-getparamatpoint en x)))
      l)
  paf (* 0.5 (+ (car pal) (cadr pal)))
  pas (* 0.5 (+ (caddr pal) (cadddr pal)))
  pf  (vlax-curve-getpointatparam en paf)
  ps  (vlax-curve-getpointatparam en pas))
    (if (equal pf ps acc) ;_(check-pt (list pf ps))
      (list (midpt pf ps) paf pas)
      (cond ((inters (car l) pf (caddr l) ps)
     (getparam en
       (list (car l)
     pf
     (caddr l)
     ps)
       acc))
    ((inters (car l) pf (cadddr l) ps)
     (getparam en
       (list (car l)
     pf
     (cadddr l)
     ps)
       acc))
    ((inters (cadr l) pf (caddr l) ps)
     (getparam en
       (list (cadr l)
     pf
     (caddr l)
     ps)
       acc))
    ((inters (cadr l) pf (cadddr l) ps)
     (getparam en
       (list (cadr l)
     pf
     (cadddr l)
     ps)
       acc)))))
  (setq _oce (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq l
((lambda (/ r)
    (if
      (not
(vl-catch-all-error-p
  (vl-catch-all-apply
    (function vl-cmdf)
    (list "_PEDIT"
  (vlax-vla-object->ename
    (vla-copy (vlax-ename->vla-object en))
    )
  ""
  10
  ""))))
       (progn
(setq
   l (ss-assoc 10 (entget (setq r (entlast)))))
(entdel r)
(if (vlax-curve-isClosed en)
   (cons (last l) l)
   l))))))
  (while l
    (setq p0 (car l)
  p1 (cadr l)
  l  (cdr l)
  l1 (cdr l))
    (while (cadr l1)
      (setq p2 (car l1)
    p3 (cadr l1)
    l1 (cdr l1))
      (if (setq p (inters p0 p1 p2 p3))
(setq ip  (getparam en (list p0 p1 p2 p3) acc)
      ips (cons ip ips))
)))
  (setvar "CMDECHO" _oce)
  ips
  ) ;_defun
;;;------------------
(defun midpt  (pta ptb)
  (mapcar (function (lambda (x y)
      (/ (+ x y) 2.0)))
  pta
  ptb))
;;
(defun ss-assoc (a lst / b res)
  (while (setq b (assoc a lst))
    (setq lst (cdr (member b lst))
  res (cons (cdr b) res)
  ))
  (reverse res))


[chlh_jd]

my New version ; The '_Pedit' method to tanslate the spline  can be changed into not use command method , Such as this

Code: [Select]

(defun c:test  (/ en ips i i% str)
  (setq en (ssname (ssget ":E:S" '((0 . "SPLINE"))) 0))
  (setq ips (vl-remove nil (ss:spline:getcrossparams en 1e-6)))
  (setq i 1)
  (if ips
    (foreach ip ips
      (entmake (list (cons 0 "POINT")
     (cons 10 (car ip))
     (cons 8 "Temp")
     (cons 62 (rem i 254))
     )
       )
      (entmake (list (cons 0 "LINE")
     (cons 10 (list 0 0 0))
     (cons 11 (car ip))
     (cons 8 "Temp")
     (cons 62 (rem i 254))
     )
       )
      (princ (strcat "\nThe " (itoa i) " self-cross point has " (itoa (1- (length ip))) "params :"))
      (setq str "\n   "
    i% 1)
      (foreach a (cdr ip)
(setq str (strcat str "The " (itoa i%) " param = " (rtos a 2 6) " ;  "))
(setq i% (1+ i%))
)
      (princ str)
      (setq i (1+ i))     
      )
    )
  (princ)
  )
;;;
(defun ss:spline:getcrossparams (en acc / _oce l l1 ip ips p0 p1 p2 p3 res)
  ;;by GSLS(SS) 2012-8-17
  ;; acc <= 1e-8
  (defun getparam  (en l acc / pal paf pas pf ps)
    (setq pal (mapcar (function (lambda (x)
  (vlax-curve-getparamatpoint en x)))
      l)
  paf (* 0.5 (+ (car pal) (cadr pal)))
  pas (* 0.5 (+ (caddr pal) (cadddr pal)))
  pf  (vlax-curve-getpointatparam en paf)
  ps  (vlax-curve-getpointatparam en pas))
    (if (equal pf ps acc) ;_(check-pt (list pf ps))
      (list (midpt pf ps) paf pas)
      (cond ((inters (car l) pf (caddr l) ps)
     (getparam en
       (list (car l)
     pf
     (caddr l)
     ps)
       acc))
    ((inters (car l) pf (cadddr l) ps)
     (getparam en
       (list (car l)
     pf
     (cadddr l)
     ps)
       acc))
    ((inters (cadr l) pf (caddr l) ps)
     (getparam en
       (list (cadr l)
     pf
     (caddr l)
     ps)
       acc))
    ((inters (cadr l) pf (cadddr l) ps)
     (getparam en
       (list (cadr l)
     pf
     (cadddr l)
     ps)
       acc)))))
  (setq _oce (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq l
((lambda (/ r)
    (if
      (not
(vl-catch-all-error-p
  (vl-catch-all-apply
    (function vl-cmdf)
    (list "_PEDIT"
  (vlax-vla-object->ename
    (vla-copy (vlax-ename->vla-object en))
    )
  ""
  10
  ""))))
       (progn
(setq
   l (ss-assoc 10 (entget (setq r (entlast)))))
(entdel r)
(if (vlax-curve-isClosed en)
   (cons (last l) l)
   l))))))
  (while l
    (setq p0 (car l)
  p1 (cadr l)
  l  (cdr l)
  l1 (cdr l))
    (while (cadr l1)
      (setq p2 (car l1)
    p3 (cadr l1)
    l1 (cdr l1))
      (if (setq p (inters p0 p1 p2 p3))
(setq ip  (getparam en (list p0 p1 p2 p3) acc)
      ips (cons ip ips))
)))
  (setvar "CMDECHO" _oce)
  (setq ips (vl-remove nil ips))
  (foreach a ips
     (if (setq b (eqassoc (car a) res acc))
       (setq res (vl-remove b res)
     b (cons (midpt (car a) (car b)) (remove-eq-doubles (append (cdr a) (cdr b)) acc))
     res (cons b res))
       (setq res (cons a res)))) 
  );_defun
;;;------------------
;;;Use function
;;;

;;;
(defun remove-eq-doubles (lst tor / f1)
  (defun f1 (a lst tor)
    (cond ((> (length lst) 1)
   (if (or (not (car lst))
   (vl-some(function (lambda (x) (equal x (car lst) tor)))
(cdr lst)))
     (f1 a (cdr lst) tor)
     (f1 (cons (car lst) a) (cdr lst) tor)    )   )
  (t (if (car lst) (cons (car lst) a) a))    )  )
  (reverse(f1 nil lst tor)))
;;
(defun midpt (pta ptb)
  (mapcar (function (lambda (x y)
      (/ (+ x y) 2.0)))
  pta
  ptb))
;;
;;
(defun eqassoc (a l eps)
    (cond ((not l)
   nil
   )
  ((equal a (caar l) eps)
   (car l)
   )
  (t (eqassoc a (cdr l) eps))
  )
    )
;;;eqmember
(defun eqmember (p l eps)
  (cond ((not l)  nil)
  ((equal p (car l) eps) l)
  (t (eqmember p (cdr l) eps))
  ))
;;
(defun ss-assoc (a lst / b res)
  (while (setq b (assoc a lst))
    (setq lst  (cdr (member b lst))
  res (cons (cdr b) res)
    ))(reverse res))   


[ribarm]

Test it with this example

[Faster]

Test it with this example

My new version,fixes some BUG.

Code: [Select]

;;Get all parameters for lwpolyline.
(defun gxl-getlwparamatpoint (LW PT / DATA DPA PA PARS EL V K NEWEL A)
  (setq data (entget lw) dpa 0)
  (while (setq pa (vlax-curve-getParamAtPoint lw pt))
    (setq pars (cons (setq dpa (+ dpa pa)) pars)
  dpa (+ 1 (fix dpa))
  el (entget lw)
  v (- (cdr (assoc 90 el)) (fix pa) 1)
  k -1
  newel nil
  )
    (while el
      (setq a (car el)
    el (cdr el)
    )
      (cond
((= 10 (car a))
(if (< k (fix pa))
   (setq k (1+ k)
el (cdddr el)
)
   (setq newel (cons a newel))
   )
)
((= 90 (car el))
(setq newel (cons (cons 90 v) newel))
)
(t (setq newel (cons a newel)))

)
      )
    (entmod (reverse newel))
    (entupd lw)
    )
  (entmod data)
 (if (and (vlax-curve-isClosed lw) (equal pt (vlax-curve-getendpoint lw) 1e-8)) (setq pars (cons (vlax-curve-getendparam lw) pars)))
  (reverse pars)
  )
;;Get all parameters for spline.
(defun gxl-getsplparamatpoint (SPL PT     /      GETPARAM OBJSPL
   OBJCIRCLE      PL       PARS0
   PA     PARS     RESULT d tpa
  )
  (defun getparam (CURVE PA1 PA2 P / PA P0 P1 P2)
    (setq pa (* 0.5 (+ pa1 pa2))
  p0 (vlax-curve-getPointAtParam curve pa)
    )
    (cond
      ((equal (setq p1 (vlax-curve-getPointAtParam curve pa1))
      (setq p2 (vlax-curve-getPointAtParam curve pa2))
      1e-8
       )
       pa
      )
      ((< (distance p p1) (distance p p2))
       (getparam curve pa1 pa p)
      )
      ((< (distance p p2) (distance p p1))
       (getparam curve pa pa2 p)
      )
      (t nil)
    )
  )
  (if (vlax-curve-getParamAtPoint spl pt)
    (progn
      (setq objspl    (vlax-ename->vla-object spl)
    objcircle (vla-addcircle
(vlax-get-property
  (vla-get-ActiveDocument (vlax-get-acad-object))
  (if (= 1 (getvar 'CVPORT))
    'PaperSpace
    'ModelSpace
  )
)
(vlax-3d-point pt)
1e-2
      )
      )
      (setq
pl (vlax-invoke objspl 'IntersectWith objcircle acExtendNone)
      )
      (vla-delete objcircle)
      (while pl
(setq pars0 (cons (vlax-curve-getParamAtPoint
   spl
   (list (car pl) (cadr pl) (caddr pl))
)
pars0
   )
      pl   (cdddr pl)
)
      )
      (setq pars0 (vl-sort pars0 '<))
      (while pars0
(setq pa (car pars0)
      pars0 (cdr pars0)
      )
(if pars0
  (progn
    (if (< (- (vlax-curve-getdistAtParam spl (car pars0)) (vlax-curve-getdistAtParam spl pa) ) 3e-2)
      (setq pars (cons (list pa (car pars0)) pars)
    pars0 (cdr pars0)
    )
      (setq pars
     (cons (list (vlax-curve-getParamatdist
     spl
     (- (setq d
       (vlax-curve-getDistAtParam
spl
pa))
2e-2))
(if (>
       (setq
       tpa (vlax-curve-getParamatdist
     spl
     (+ d
2e-2)))
       0
       )
   tpa
   (vlax-curve-getendParam spl))
)
   pars
   )
    )
      )
    )
  (setq pars
     (cons (list (vlax-curve-getParamatdist
     spl
     (- (setq d
       (vlax-curve-getDistAtParam
spl
pa))
2e-2))
(if (>
       (setq
       tpa (vlax-curve-getParamatdist
     spl
     (+ d
2e-2)))
       0
       )
   tpa
   (vlax-curve-getendParam spl))
)
   pars
   )
    )
  )
)
      (foreach par (reverse pars)
(if (setq pa (getparam spl (car par) (cadr par) pt))
  (setq result (cons pa result))
)
      )
      (reverse result)

    ) ;_ progn
  )
)
;;Get all parameters for any curves.
(defun gxl-getparamatpoint (CURVE PT / CURVETYPE ENL DATA E EL PAR)
  (if (= 'VLA-OBJECT (type curve))
    (setq curve (vlax-vla-object->ename curve))
  )
  (cond
    ((= "SPLINE" (setq curvetype (cdr (assoc 0 (entget curve)))))
     (gxl-getsplparamatpoint curve pt)
    )
    ((= "LWPOLYLINE" curvetype)
     (GXL-GETLWPARAMATPOINT curve pt)
    )
    ((= "POLYLINE" curvetype)
     (setq enl (entget curve)
   data
(list
  '(0 . "LWPOLYLINE")
  '(100 . "AcDbEntity")
  (assoc 8 enl)
  '(100 . "AcDbPolyline")
  (cons 90 (fix (vlax-curve-getendparam curve)))
  (cons 70
(if (vlax-curve-isClosed curve)
  1
  0
)
  )
)
   e curve
     )
     (while (and
      (setq e (entnext e))
      (/= (cdr (assoc 0 (entget e))) "SEQEND")
    )
       (setq el (entget e))
       (setq
data (append data
      (list (reverse (cdr (reverse (assoc 10 el))))
    (assoc 40 el)
    (assoc 41 el)
    (assoc 42 el)
      )
      )
       )

     )
     (entmake data)
     (setq curve (entlast))
     (setq par (GXL-GETLWPARAMATPOINT curve pt))
     (entdel curve)
     par
    )
    (t
     (if (setq par (vlax-curve-getParamAtPoint curve pt))
       (list par)
     )
    )
  )
)
;(c:test)
(defun c:test (/ e p pars)
  (setq e (car (entsel "\nSelect a curve:"))
p (getpoint "\nSelect Point : ")
)
  (if (and e p)
    (progn
    (setq pars (gxl-getparamatpoint e p))
    (if pars
      (progn
(princ "\n Params is : ")
(foreach a pars (princ a) (princ "  "))
)
      (princ "\nNull...")
      )
    )
    )
  (princ)
  )



[ribarm]

Congratulations, Faster... It works fine, just my minor modification :

Code: [Select]

;;Get all parameters for lwpolyline.
(defun gxl-getlwparamatpoint (LW PT / DATA DPA PA PARS EL V K NEWEL A)
  ...
  (if (equal pt (vlax-curve-getendpoint lw) 1e-8) (setq pars (cons (vlax-curve-getendparam lw) pars)))
  (reverse pars)
)

M.R.

[Faster]

Congratulations, Faster... It works fine, just my minor modification :

Code: [Select]

;;Get all parameters for lwpolyline.
(defun gxl-getlwparamatpoint (LW PT / DATA DPA PA PARS EL V K NEWEL A)
  ...
  (if (equal pt (vlax-curve-getendpoint lw) 1e-8) (setq pars (cons (vlax-curve-getendparam lw) pars)))
  (reverse pars)
)

M.R.

Thanks  for your advice.A little improvement for your modification :

Code - Auto/Visual Lisp: [Select]

1. ...
2. (if (and (vlax-curve-isClosed lw) (equal pt (vlax-curve-getendpoint lw) 1e-8)) (setq pars (cons (vlax-curve-getendparam lw) pars)))
3. ...
4.  

[ribarm]

Thanks, Faster... Another example for testing - now you should get 3 params as start and end point isn't point of cross-intersections... I got in previous example 4 params (start+end) witch is correct taking in consideration how spline was drawn...

M.R.

[Faster]

Thanks, Faster... Another example for testing - now you should get 3 params as start and end point isn't point of cross-intersections... I got in previous example 4 params (start+end) witch is correct taking in consideration how spline was drawn...

M.R.

Yes，Your  previous example  should get 4 params ,and the second example  get 3 params .

[chlh_jd]

New version

Code: [Select]

(defun c:test  (/ en ips i i% str)
  (setq en (ssname (ssget ":E:S" '((0 . "SPLINE"))) 0))
  (setq ips (vl-remove nil (ss:spline:getcrossparams en 1e-5)))
  (setq i 1)
  (if ips
    (foreach ip ips
      (entmake (list (cons 0 "POINT")
     (cons 10 (car ip))
     (cons 8 "Temp")
     (cons 62 (rem i 254))
     )
       )
      (if (not (equal (car ip) '(0 0 0) 1e-5))
(entmake (list (cons 0 "LINE")
       (cons 10 (list 0 0 0))
       (cons 11 (car ip))
       (cons 8 "Temp")
       (cons 62 (rem i 254))
       )
))
      (princ (strcat "\nThe "
     (itoa i)
     " self-cross point"
     (vl-princ-to-string (car ip))
     " has "
     (itoa (1- (length ip)))
     "params :"))
      (setq str "\n   "
    i% 1)
      (foreach a  (cdr ip)
(setq str (strcat str
  "The "
  (itoa i%)
  " param = "
  (rtos a 2 6)
  " ;  "))
(setq i% (1+ i%))
)
      (princ str)
      (setq i (1+ i))
      )
    )
  (princ)
  )
;;;
(defun ss:spline:getcrossparams (en acc / l l0 l1 ip ips p0 p1 p2 p3 Firstp
  res pas pae isclosed  ;| t1 |;)
  ;; Get all self intersections's parameters
  ;; en  ---- spline enmae
  ;; acc ---- Global accuracy , <= 1e-8
  ;; by GSLS(SS) 2012-8-21
  ;;
  (defun ss:spl2pl
(en dst ato / ent pto ptn dss dse ans ane an dn dsi an0 p)
    ;;translate spline into pline
    ;; en  ---- spline enmae
    ;; dst ---- limit distance .
    ;; ato ---- limit angle .
    (setq ent (entget en)
  pto
      (if (assoc 11 ent)
(ss-assoc 11 ent)
(list (cdr (assoc 10 ent)) (cdr (assoc 10 (reverse ent))))
))
    (if (and (vlax-curve-isclosed en)
     (not (equal (car pto) (last pto) 1e-6)))
      (setq pto (cons (last pto) pto)))
    (setq
      ptn (list (car pto))
      pto (cdr pto)
      dss 0.0
      )
    (while pto
      (setq dse (vlax-curve-getParamAtPoint en (car pto)))
      (if (< dse dss)
(setq
  dse (getnextparam
en
dss
(if (cadr pto)
  (vlax-curve-getParamAtPoint en (cadr pto)))
(car ptn)
(car pto))))
      (setq
ans (angle '(0 0 0) (vlax-curve-getFirstDeriv en dss))
ane (angle '(0 0 0) (vlax-curve-getFirstDeriv en dse)))
      (if (and (<= (* 1.5 pi) ans  (* 2.0 pi))
       (< 0 ane (* 0.5 pi)))
(setq ane (+ ane pi pi)))
      (setq
an  (1+ (fix (/ (abs (- ane ans)) ato)))
dn  (1+ (fix (/ (distance (car pto) (car ptn)) dst)))
dsi (/ (- dse dss) (max an dn)))
      (while (< (setq dss (+ dss dsi)) (- dse 1e-5))
(setq ptn (cons (vlax-curve-getpointatparam en dss) ptn)))
      (setq ptn (cons (car pto) ptn)
    pto (cdr pto)
    dss dse))
    (reverse ptn)
    )
  ;;
  (defun getnextparam  (en dss dsm p0 p1 / dse p dsi dsl i)
    ;; get point p1's  parameter
    ;; en  ---- spline enmae
    ;; dss ---- start point p0 's param
    ;; dsm ---- the p1's next point
    ;; p0  ---- start point
    ;; p1  ---- end point
    (if (or (not dsm) (= dsm 0.0))
      (setq dsm (vlax-curve-getendparam en)))
    (setq dse (* 0.5 (+ dss dsm))
  dsi (* (- dsm dss) 0.5)
  i   0
  )
    (while
      (and (not (equal (setq p (vlax-curve-getpointatparam en dse))
       p1
       1e-6))
   (< i 40))
       (setq dsi (* dsi 0.1)
     dsl (list (- dse (* dsi 10))))
       (repeat 20
(setq dsl (cons (+ (car dsl) dsi) dsl)))
       (setq dsl (vl-remove-if-not
   (function (lambda (x)
       (and (> x dss)
    (<= x dsm)
    )
       )
     )
   dsl)
     dsl (vl-sort
   dsl
   (function
     (lambda (e1 e2)
       (< (distance (vlax-curve-getpointatparam en e1)
    p1)
  (distance (vlax-curve-getpointatparam en e2)
    p1)))))
     dse (car dsl)
     i (1+ i)))
    dse)
  ;;
  (defun getparam  (en m acc / pal paf pas pf ps pafs pafe pass pase)
    ;; get inters & it's parameters
    ;; en ---- spline enmae
    ;; m  ---- a point list like (list p0 p1 p2 p3) , line p0--p1 intersect with line p2--p3
    ;; acc ---- Global accuracy
    (setq pal  (mapcar (function (lambda (x)
   (vlax-curve-getparamatpoint en x)))
       m)
  pafs (car pal)
  pafe (cadr pal)
  pass (caddr pal)
  pase (cadddr pal))
    (if (< pafe pafs)
      (setq pafe (getnextparam
   en
   pafs
   (if (cadr l)
     (vlax-curve-getparamatpoint en (cadr l))
     (vlax-curve-getendparam en))
   (car m)
   (cadr m))))
    (if (< pase pass)
      (setq pase (getnextparam
   en
   pass
   (if (cadr l1)
     (vlax-curve-getparamatpoint en (cadr l1))
     (vlax-curve-getendparam en))
   (caddr m)
   (cadddr m))))
    (setq
      paf (* 0.5 (+ pafs pafe))
      pas (* 0.5 (+ pass pase))
      pf  (vlax-curve-getpointatparam en paf)
      ps  (vlax-curve-getpointatparam en pas))
    (if (equal pf ps acc)
      (list (midpt pf ps) paf pas)
      (cond ((inters (car m) pf (caddr m) ps)
     (getparam en
       (list (car m)
     pf
     (caddr m)
     ps)
       acc))
    ((inters (car m) pf (cadddr m) ps)
     (getparam en
       (list (car m)
     pf
     ps
     (cadddr m))
       acc))
    ((inters (cadr m) pf (caddr m) ps)
     (getparam en
       (list pf
     (cadr m)
     (caddr m)
     ps)
       acc))
    ((inters (cadr m) pf (cadddr m) ps)
     (getparam en
       (list pf
     (cadr m)
     ps
     (cadddr m))
       acc)))))
 ;_(setq t1 (getvar "Millisecs"))
  (setq l  (ss:spl2pl en 50. 0.05236) ;_This two param perhaps must be open ....
l0 l)
 ;_(draw-pl (list l (cons 62 1)))
 ;_(setq gsls_test_point (getpoint))
    ;;for deal result
  (setq pas (vlax-curve-getstartparam en)
pae (vlax-curve-getendparam en)
isclosed (vlax-curve-isclosed en)
firstp T)
  (while l
    (setq p0 (car l)
  p1 (cadr l)
  l  (cdr l)
  l1 (cdr l))
    (if (equal p0 gsls_test_point 1e-6)
      (princ))
    (while (cadr l1)
      (setq p2 (car l1)
    p3 (cadr l1)
    l1 (cdr l1))
      (if
(and (setq p (inters p0 p1 p2 p3)) (not (and isclosed firstp (not (cadr l1)))))
(setq ip  (getparam en (list p0 p1 p2 p3) acc);_(check-pt (list p0 p1 p2 p3))
       ips (cons ip ips))
)
      )
    (setq firstp nil)
    )
 ;_(setvar "CMDECHO" _oce)
  (setq ips (vl-remove nil ips)) 
  ;;deal result
  (foreach a  ips
    (if (setq b (eqmember (car a) l0 acc)) ;_correct intersection
      (setq a (cons (car b) (cdr a))))
    (setq b (mapcar (function (lambda (x)
(if (equal x pas acc)
  pas
  (if (equal x pae acc)
    (if isclosed
      pas
      pae)
    x))))
    (cdr a))) ;_correct parameters
    (setq a (cons (car a) b))
    ;; conform the result
    (if (setq b (eqassoc (car a) res acc))
      (setq res (vl-remove b res)
    b (cons (midpt (car a) (car b))
      (vl-sort
(remove-eq-doubles (append (cdr a) (cdr b)) (* 10. acc))
'<))
    res (cons b res))
      (setq res (cons a res))))
  ;| (princ (strcat "\nUse time = " (rtos (- (getvar "Millisecs") t1) 2 3) " ms."))
  res|;
  )
;;;------------------
;;;Use function
;;;

;;;
(defun remove-eq-doubles (lst tor / f1)
  (defun f1 (a lst tor)
    (cond ((> (length lst) 1)
   (if (or (not (car lst))
   (vl-some(function (lambda (x) (equal x (car lst) tor)))
(cdr lst)))
     (f1 a (cdr lst) tor)
     (f1 (cons (car lst) a) (cdr lst) tor)    )   )
  (t (if (car lst) (cons (car lst) a) a))    )  )
  (reverse(f1 nil lst tor)))
;;
(defun midpt (pta ptb)
  (mapcar (function (lambda (x y)
      (/ (+ x y) 2.0)))
  pta
  ptb))
;;
;;
(defun eqassoc (a l eps)
    (cond ((not l)
   nil
   )
  ((equal a (caar l) eps)
   (car l)
   )
  (t (eqassoc a (cdr l) eps))
  )
    )
;;;eqmember
(defun eqmember (p l eps)
  (cond ((not l)  nil)
  ((equal p (car l) eps) l)
  (t (eqmember p (cdr l) eps))
  ))
;;
(defun ss-assoc (a lst / b res)
  (while (setq b (assoc a lst))
    (setq lst  (cdr (member b lst))
  res (cons (cdr b) res)
    ))(reverse res))
;;
Test result for ribarm's first example

Code: [Select]

_$ (c:test)

The 1 self-cross point(0.0 0.0 0.0) has 3params :
   The 1 param = 0.000000 ;  The 2 param = 214.220642 ;  The 3 param = 428.441302 ; 
_$

Test result for ribarm's second example

Code: [Select]

_$ (c:test)

The 1 self-cross point(1.77636e-015 7.54952e-015 0.0) has 3params :
   The 1 param = 160.771611 ;  The 2 param = 482.314796 ;  The 3 param = 803.684330 ; 
_$


[chlh_jd]

Test it with this example

My new version,fixes some BUG.

Code: [Select]

;;Get all parameters for lwpolyline.
(defun gxl-getlwparamatpoint (LW PT / DATA DPA PA PARS EL V K NEWEL A)
  (setq data (entget lw) dpa 0)
  ....


Nice Routine Faster , if we knew the intsections , yours   result  will get better than mine .

Thanks, Faster... Another example for testing - now you should get 3 params as start and end point isn't point of cross-intersections... I got in previous example 4 params (start+end) witch is correct taking in consideration how spline was drawn...

M.R.

Yes，Your  previous example  should get 4 params ,and the second example  get 3 params .

If  Spline is closed and the start point is one of the cross-intersections ,  the endparam is not need to often , just I think .

[ribarm]

Again one modification :

Code: [Select]

(defun c:test (/ e p pars)
  (setq e (car (entsel "\nSelect a curve:"))
p (getpoint "\nSelect Point : ")
)
  (if (and e p)
    (progn
    (setq pars (gxl-getparamatpoint e p))
    (if pars
      (progn
(princ "\n Params is : ")
(foreach a pars (princ (rtos a 2 15)) (princ "  "))
)
      (princ "\nNull...")
      )
    )
    )
  (princ)
  )

By picking start-end point of spline object Faster's code precision is in range of 1e-8, so having that in mind I suppose it is more trust worth than chlh_jd's with witch precision results are in range of 1e-5 no matter if you change in chlh_jd's code line (rtos a 2 15) - still tolerance is 1e-5 in witch subfunction (ss:spline:getcrossparams en 1e-5) operates...

[chlh_jd]

Again one modification :

Code: [Select]

(defun c:test (/ e p pars)
  (setq e (car (entsel "\nSelect a curve:"))
p (getpoint "\nSelect Point : ")
)
 ....
 
By picking start-end point of spline object Faster's code precision is in range of 1e-8, so having that in mind I suppose it is more trust worth than chlh_jd's with witch precision results are in range of 1e-5 no matter if you change in chlh_jd's code line (rtos a 2 15) - still tolerance is 1e-5 in witch subfunction (ss:spline:getcrossparams en 1e-5) operates...

You're right , Ribarm .
I'll  Fix this problem some day later  , Today must to sleep .

[Faster]

...

Nice Routine Faster , if we knew the intsections , yours   result  will get better than mine .

...

Get self-intersection points with next method:

Code: [Select]

(vlax-invoke (setq obj (vlax-ename->vla-object (car(entsel)))) 'IntersectWith obj acExtendNone)

[ribarm]

...

Nice Routine Faster , if we knew the intsections , yours   result  will get better than mine .

...

Get self-intersection points with next method:

Code: [Select]

(vlax-invoke (setq obj (vlax-ename->vla-object (car(entsel)))) 'IntersectWith obj acExtendNone)

Unfortunately, that will only find start point of obj VLA-OBJECT, but hey, now I can find intersections of 2 separate splines - there are no int osnap for this :

Code: [Select]

(vlax-invoke (setq obj1 (vlax-ename->vla-object (car(entsel)))) 'IntersectWith (setq obj2 (vlax-ename->vla-object (car(entsel)))) acExtendNone)

And one more thing, change 1e-8 to 1e-14 in Faster's code here :

Code: [Select]

    (cond
      ((equal (setq p1 (vlax-curve-getPointAtParam curve pa1))
      (setq p2 (vlax-curve-getPointAtParam curve pa2))
      1e-8
       )
       pa
      )
     ...
    ) ; end cond

and you'll see that precision is even better - around 1e-10 for picked some point on curve - start-end points if picked have even more precise parameters...

M.R.

[ribarm]

Unfortunately, that will only find start point of obj VLA-OBJECT, but hey, now I can find intersections of 2 separate splines - there are no int osnap for this :

Code: [Select]

(vlax-invoke (setq obj1 (vlax-ename->vla-object (car(entsel)))) 'IntersectWith (setq obj2 (vlax-ename->vla-object (car(entsel)))) acExtendNone)


I was wrong, but fortunately - there is int osnap when intersecting 2 splines - only no int when one spline crosses itself...

M.R.