;;;;;; LISP Zur verlegung eines Blockes an einer Polyline            ;;;;;;
;;;;;; mit Einschränkung eines maximalwinkels zwischen zwei Blöcken  ;;;;;;
;;;;;; (Achtung Winkel über die 0/360° Grenze werden gestoppt)       ;;;;;;
;;;;;; Version 1.0  04.04.2014 Auto CAD 2014                         ;;;;;;
;;;;;; nebuCADnezzar                                                 ;;;;;;


(defun c:elplaz (/ ABSTAND ABSTANDIST FUZZ L1 L2 L3 OBJ P1 P2 P3 P4 RAD WIN1 WIN2)
  (setq L1 4.0140
        Fuzz 0.0000001)
  
  (if (and (setq obj (car(entsel "\nPolylinie auswählen:")))
          (member(cdr(assoc 0 (entget obj)))'("LWPOLYLINE" "POLYLINE"))
          (setq P1 (getpoint "\nStartPunkt:"))
          (setq P1 (vlax-curve-getClosestPointTo obj P1)))
    ;;;Wenn Punkt2 (P2) von Waggon 1
    (if (setq P2 (test:WaggonP2 P1 obj L1 Fuzz))
      (progn
        ;;;KontrolLinien zeichnen
        (test:LineEntmake P1 P2)
	(setq RAD (angle P1 P2))
   	(setq WIN1 (atof (angtos RAD 0 8)))
	(command "_.insert" "Panel 4m" P1 1 1 WIN1)
	
      )
     )
   )

	(setq P1 P2)

(while
  (and
	 (setq P2 (test:WaggonP2 P1 obj L1 Fuzz))
	 (progn
	       	 (setq RAD (angle P1 P2))
   		 (setq WIN2 (atof (angtos RAD 0 8)))
                 ;(<= (test:WinkelDiff WIN1 WIN2)3.0)
	         ;(<= (*(/(test:WinkelDiff WIN1 WIN2)pi)180.0)3.0)
	         (<=(abs(- WIN1 WIN2)) 3.0)
      	)
       )	 

  (progn
        ;;;KontrolLinien zeichnen
	(test:LineEntmake P1 P2)
	(command "_.insert" "Panel 4m" P1 1 1 WIN2)
	(setq P1 P2)
        (setq WIN1 WIN2)
  )

  
)
)




(defun test:LineEntmake (p1 p2 / )
  (entmake(list (cons 0 "LINE")
                (cons 10 P1)
                (cons 11 P2))))

;;;2. Punkt eines Waggons bestimmen
(defun test:WaggonP2 (P1 obj L1 Fuzz / ABSTANDIST DISTATP1 L1POLY P2 RETVALCHECK)
  (setq L1Poly L1
        DistAtP1 (vlax-curve-GetDistAtPoint obj P1))
  (while (not P2)
    (if (setq retvalCheck(test:WaggonP2:AbstandCheck P1 obj L1Poly DistAtP1 L1 Fuzz))
      (progn
        (setq AbstandIst (cadr retvalCheck)
              P2 (car retvalCheck))
        (if (not P2)
          (setq L1Poly (+ (/ (- L1 AbstandIst) 2.0)L1Poly))))
          (progn
            (alert "Elementende befindet sich nicht auf der Poly")
            (exit))))
  P2

      ) 

(defun test:WaggonP2:AbstandCheck (P1 obj L1Poly DistAtP1 L1 Fuzz / ABSTANDIST P2)
  (if(and(setq P2 (vlax-curve-getPointAtDist obj
                      (+ DistAtP1 L1Poly)))
        (setq AbstandIst (distance P1 P2)))
    (if (equal L1 AbstandIst Fuzz)
      (list P2 AbstandIst)
      (list nil AbstandIst))))


(defun test:WinkelDiff (w1 w2 / A B C PA PB PC)
    (setq pC '(0.0 0.0 0.0)
          a 10.0
          b 10.0
          pA (polar pC w1 a)
          pB (polar pC w2 b)
          c (distance pA pB))
    ;(entmake (list(cons 0 "LINE")(cons 10 pA)(cons 11 pB)))
    (arcos(/(-(+(* a a)(* b b))(* c c))
          (*(* 2.0 a)b))))


(defun arcos (x / )
  (atan (sqrt (- 1 (* x x)))x)
  )