[Krieger]

Нужна программка для определения координат точек пересечения сплайна с несколькими прямыми (line, pline, xline, ray) и все координаты попорядку (по ходу движения сплайна) записать в один список.

[VVA]

Код:

[Выделить все]

; -- Function VxGetInters
; Returns all intersection points between two objects.
; Copyright:
;   ©2000 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
;   Fst = First object [VLA-OBJECT]
;   Nxt = Second object [VLA-OBJECT]
;   Mde = Intersection mode [INT]
;         Constants:
;         - acExtendNone           Does not extend either object.
;         - acExtendThisEntity     Extends the Fst object.
;         - acExtendOtherEntity    Extends the Nxt object.
;         - acExtendBoth           Extends both objects.
; Return [Type]:
;   > List of points '((1.0 1.0 0.0)... [LIST]
;   > Nil if no intersection found
; Notes:
;   - None
; 
(defun VxGetInters (Fst Nxt Mde / IntLst PntLst)
 (setq IntLst (vlax-invoke Fst 'IntersectWith Nxt Mde))
 (cond
  (IntLst
   (repeat (/ (length IntLst) 3)
    (setq PntLst (cons
                  (list
                   (car IntLst)
                   (cadr IntLst)
                   (caddr IntLst)
                  )
                  PntLst
                 )
          IntLst (cdddr IntLst)
    )
   )
   (reverse PntLst)
  )
  (T nil)
 )
)

;;;prmpt - приглашение
;;;myfilter - фильтр объетков '("LWPOLYLINE" "ARC" "POLYLINE" "LINE" "ELLIPSE" "SPLINE")
;;; sps - список объектов,чтобы не выбирали дважды один и тот же или nil
;;; Точку выбора заносит в LASTPOINT

(defun mip_get_entt ( prmpt myfilter sps / Bl e1 prname str aa e2 pt)
 (setq BL t)
 (while BL
  (setvar "ERRNO" 0)
  (setq e1 (entsel (strcat "\n" prmpt " <выход>:")))
  (setq pt (cadr e1) e1 (car e1))
  (if pt (setvar "LASTPOINT" pt))
  (if (member e1 sps)
  (progn
    (alert "Примитив уже выбран")
  )
  (progn  
   (if e1
    (progn
      (setq prname (cdr(assoc 0 (entget e1))))
      (if myfilter
	(progn
	  (if (member prname myfilter)
	    (setq BL nil)
	    (progn
	      (setq str "\nПримитив должен быть типа\n")
	      (foreach aa myfilter
		(setq str (strcat str aa " "))
	      )
	      (alert str)
	    )  
	  )  
	)
	(setq BL nil)
      )	
    )
    (progn
      (setq e2 (getvar "ERRNO"))
      (cond 
           ((= e2 7) ;;;Пустой выбор
             (alert "Ничего не выбрано")
             (setq BL t)
            )
           ((= e2 52) ;;;Клавиша Ввод(выход)
             (setq BL nil e1 nil)
            )
          (t (alert "Необходимо выбрать примитив")
             (setq BL t)
          )
      )

    )
   )
 )
)    
  );_while
  e1
)

(defun C:ISPL ( / E1 E2 SPS line_list)
  (setq E1 (MIP_GET_ENTT "Выберите сплайн" '("SPLINE") SPS))
  (redraw E1 3)
  (if E1 (setq SPS (append SPS (list E1))))
  (while
   (setq E2 (MIP_GET_ENTT "Выберите 2-й примитив"
       	 '("LWPOLYLINE" "POLYLINE" "LINE" "RAY" "XLINE")
	 SPS
       ))
    (if E2
      (progn
      (setq SPS (append SPS (list E2))
	    line_list (append line_list (list E2))
	    )
      )
      )
    (redraw E2 3)
   );_while
  (foreach E2 SPS (redraw E2 4))
  (setq SPS nil *PT_LIST* nil)
  (foreach E2 line_list
    (setq SPS (VxGetInters (vlax-ename->vla-object E1)(vlax-ename->vla-object E2) acExtendOtherEntity))
    (if SPS (setq *PT_LIST* (append *PT_LIST* SPS)))
    )
  (princ "\nСписок точек=")(princ *PT_LIST*)
  (princ "\nСохранен в переменной *PT_LIST*")
;;; Рисуем полилинию по точкам  
;;;  (command "_PLINE" "0,0")
;;;  (foreach e1 *PT_LIST* (command e1))
;;;  (command "")
  (princ)
  )
(princ "\nНабери ISPL")

Непонятно как определить

попорядку (по ходу движения сплайна)

Пока что в списке *PT_LIST* координаты в порядке выбора 2-х примитивов. Можно отсортировать по Х.

[Эдуард]

Как-то так.

Код:

[Выделить все]

(vl-load-com)
(defun spline_inters (/ spl inters_obj)
  (if
    (and
      (not (prompt "\nSelect spline:"))
      (setq spl (car (entsel)))
      (not (prompt "\nSelect intersect objects:"))
      (setq inters_obj
	     (ssget '((0 . "line,xline,ray,lwpolyline,polyline")))
      )
      (= (vla-get-ObjectName (setq spl (vlax-ename->vla-object spl)))
	 "AcDbSpline"
      )
      (setq inters_obj
	     (mapcar 'vlax-ename->vla-object
		     (vl-remove-if
		       'listp
		       (mapcar 'cadr
			       (ssnamex inters_obj)
		       )
		     )
	     )
      )
    )
     (vl-sort
       (apply
	 'append
	 (vl-remove
	   'nil
	   (mapcar
	     '(lambda (x / y)
		(if
		  (minusp (vlax-safearray-get-u-bound
			    (setq y (vlax-variant-value
				      (vla-IntersectWith spl x acextendnone)
				    )
			    )
			    1
			  )
		  )
		   nil
		   (divide_coord
		     (vlax-safearray->list y)
		   )
		)

	      )
	     inters_obj
	   )
	 )
       )
       '(lambda	(w e)
	  (> (vlax-curve-getDistAtPoint spl w)
	     (vlax-curve-getDistAtPoint spl e)
	  )
	)
     )


  )
)
;;;;****************************************************************************
(defun divide_coord (lst)
  (if lst
    (cons
      (list (car lst) (cadr lst) (caddr lst))
      (divide_coord (cdddr lst))
    )
  )
)

[Krieger]

>Эдуард, VVA
Отлично! Пригодятся оба варианта. Спасибо.