;| acmOFaMo

Vier erweiterte Objektfangmodi für die Verwendung bei der Punktauswahl.


%	findet einen Punkt in einem bekannten prozentualen Abstand zwischen zwei zu wählenden Punkten.
rl	findet einen Punkt in einem bekannten X- und Y-Abstand zum letzten oder einem zu wählenden Punkt.
lw	findet einen Punkt in einem bekannten Abstand und Winkel zum letzten oder einem zu wählenden Punkt.
l2	findet einen Punkt auf einer Lotrechten zum letzten oder einem zu wählenden Punkt.

Die Eingaben erfolgen in allen Fällen ohne vorangestellte Sonderzeichen wie @, % oder <.


Plattform: ab AutoCAD 2022

Copyright
Markus Hoffmann, www.CADmaro.de
|;


 ;|
---------------
HAUPTFUNKTIONEN
---------------
|;

 ;|
Hauptfunktion "%"

Gibt einen Punkt zurück in einem bekannten prozentualen Abstand zwischen zwei zu wählenden Punkten.
Mit einer positiven Zahl wird vom ersten Punkt ausgegangen, mit einer negativen vom zweiten Punkt.
|;
(defun c:% (/ lPt)
  (setq lPt (%))
  (mx:OsmodeOff)
  lPt
)

 ;|
Hauptfunktion "Relativ"

Gibt einen Punkt zurück in einem bekannten X-, Y- und Z-Abstand zum letzten oder einem zu wählenden Bezugspunkt.
Die Eingabe erfolgt ohne @
|;
(defun c:rl (/ lPt)
  (setq lPt (rl))
  (mx:OsmodeOff)
  lPt
)

 ;|
Hauptfunktion "Länge,Winkel"

Gibt einen Punkt zurück auf einer Lotrechten zum letzten oder einem zu wählenden Bezugspunkt.
Eingabe erfolgt ohne @ und <
|;
(defun c:lw (/ lPt)
  (setq lPt (lw))
  (mx:OsmodeOff)
  lPt
)

 ;|
Hauptfunktion L2

Gibt einen Punkt zurück auf einer Lotrechten zum letzten oder einem zu wählenden Punkt
|;
(defun c:l2 (/ eBaseline pFoot rAngle lPonE lNewPoint)
  (mx:OsmodeOff)
  (arxload "geomcal")
  (if
    (setq eBaseline (nentsel "\nBasisline für Lot wählen "))
     (progn
       (mx:OsmodeOn)
       (redraw (car eBaseline) 3)
       (setq pFoot
              (getpoint
                "\nFußpunkt wählen oder <Return> um vorherigen Punkt auf der Basislinie zu wählen: "
              )
       )
       (princ "\n")
       (setq rAngle
              (+ (deg2rad 90.0)
                 (angle
                   (setq
                     lPonE
                      (vlax-curve-getClosestPointTo
                        (vlax-ename->vla-object
                          (car eBaseline)
                        )
                        (cond
                          (pFoot)
                          ((setq pFoot (cadr eBaseline)))
                        )
                      )
                   )
                   (mx:ClosestEndpointTo
                     (vlax-ename->vla-object
                       (car eBaseline)
                     )
                     lPonE
                   )
                 )
              )
       )
       (setq lNewPoint
              (mx:grdrawLine@Angle
                lPonE
                rAngle
              )
       )
       (redraw (car eBaseline) 4)
     )
  )
  (mx:OsmodeOff)
  lNewPoint
)

;| %

Funktion des %-Objektfangs
|;
(defun % (/ l1stPoint l2ndPoint rPercent)
  (if
    (and
      (setq l1stPoint (getpoint "\nErster Punkt: "))
      (setq l2ndPoint (getpoint "\nZweiter Punkt: "))
    )
     (progn
       (grdraw l1stPoint l2ndPoint -1 1)
       (setq
         rPercent
          (getreal
            (strcat
              "\nProzentualen Abstand eingeben. (Positive Eingabe: Vom 1.Punkt. Negative Eingabe: Vom 2.Punkt.) <"
              (if *acmPercentage*
                (vl-princ-to-string *acmPercentage*)
                ""
              )
              ">: "
            )
          )
       )
       (if rPercent
         (setq *acmPercentage* rPercent)
       )
       (redraw)
       (mx:PercentPolar
         (if (minusp *acmPercentage*)
           (list l2ndPoint l1stPoint (abs *acmPercentage*))
           (list l1stPoint l2ndPoint (abs *acmPercentage*))
         )
       )
     )
  )
)

;| lw

Funktion für Länge-und-Winkel-Objektfangs
|;
(defun lw (/ lBasePt lstLenWin lPt)
  (setq lBasePt (getvar "LASTPOINT"))
  (while
    (not
      (setq
        lstLenWin
         (getpoint
           "\nLänge und Winkel kommagetrennt eingeben oder <ENTER> für neuen Bezugspunkt:"
         )
      )
    )
     (mx:OsmodeOn)
     (setq lBasePt (getpoint "\nNeuer Bezugspunkt: "))
  )
  (setq lPt
     (polar
       lBasePt
       (*
         (cadr lstLenWin)
         (/ pi 180)
       )
       (car lstLenWin)
     )
  )
  lPt
)

;| rl

Funktion für Relative-Punkteingabe-Objektfang
|;
(defun rl (/ lBasePt lXYZ lPt)
  (setq lBasePt (getvar "LASTPOINT"))
  (while
    (not
      (setq
        lXYZ
         (getpoint
           "\nX-,Y- oder X-,Y- und Z-Abstand kommagetrennt eingeben oder <ENTER> für neuen Bezugspunkt:"
         )
      )
    )
     (mx:OsmodeOn)
     (setq lBasePt (getpoint "\nNeuer Bezugspunkt: "))
  )
  (setq
    lPt
     (mapcar
       '(lambda (a b)
          (+ a b)
        )
       lBasePt
       lXYZ
     )
  )
  lPt
)

 ;| mx:grdrawLine@Angle

Zeichnet eine temporäre Linie mit gegebenem Startpunkt und Winkel
und gibt nach Klick den Endpunkt der Linie zurück

-> pt = Startpunkt
-> ang = Winkel
|;
(defun mx:grdrawLine@Angle (pt ang / readGr result)
  (while
    (and
      (setq readGr (grread 5))
      (= (car readGr) 5)
    )
     (redraw)
     (grdraw
       pt
       (setq result
              (polar
                pt
                (+
                  ang
                  (deg2rad
                    (mx:LeftOrRight
                      (vlax-ename->vla-object
                        (car eBaseline)
                      )
                      (cadr readGr)
                    )
                  )
                )
                (mx:CalcPerpDist
                  (cadr readGr)
                  (vlax-curve-getstartpoint
                    (vlax-ename->vla-object
                      (car eBaseline)
                    )
                  )
                  (vlax-curve-getendpoint
                    (vlax-ename->vla-object
                      (car eBaseline)
                    )
                  )
                )
              )
       )
       -1
       1
     )
  )
  (redraw)
  result
)

 ;| mx:CalcPerpDist

Berechnet den lotrechten Abstand von pt auf der Strecke pt1-pt2

Voraussetzung: GEOMCAL.ARX ist geladen
|;
(defun mx:CalcPerpDist (pt pt1 pt2)
  (cal "dpl(pt,pt1,pt2)")
)

 ;| mx:ClosestEndpointTo

Gibt den am nächsten gelegenen Punkt auf der gewählten Linie zurück

-> o = VLA-Objekt
-> lPt = Pickpunkt auf Element
|;
(defun mx:ClosestEndpointTo (o lPt / lStartPt lEndPt)
  (if (<=
        (mx:DistonObject
          o
          lPt
          (setq lStartPt
                 (vlax-curve-getstartpoint o)
          )
        )
        (mx:DistonObject
          o
          lPt
          (setq lEndPt
                 (vlax-curve-getendpoint o)
          )
        )
      )
    lStartPt
    lEndPt
  )
)

 ;| mx:DistonObject

Berechnet die Länge zwischen zwei Punkten auf einem linearen Objekt
|;
(defun mx:DistonObject (o lPt1 lPt2 /)
  (abs
    (-
      (vlax-curve-getdistatpoint
        o
        (vlax-curve-getclosestpointto
          o
          lPt1
        )
      )
      (vlax-curve-getdistatpoint
        o
        (vlax-curve-getclosestpointto
          o
          lPt2
        )
      )
    )
  )
)

 ;| mx:LeftOrRight

Gibt an, ob der übergebene Punkt links oder rechts vom Objekt liegt
|;
(defun mx:LeftOrRight (o pt)
  (if
    (>
      (angle
;;;	 (mx:Variant2List
;;;	   (vlax-get-property o 'StartPoint)
;;;	 )
        (vlax-curve-getStartPoint o)
        pt
      )
      (angle
;;;	 (mx:Variant2List
;;;	   (vlax-get-property o 'StartPoint)
;;;	 )
        (vlax-curve-getStartPoint o)
;;;	 (mx:Variant2List
;;;	   (vlax-get-property o 'EndPoint)
;;;	 )
        (vlax-curve-getEndPoint o)
      )
    )
     180
     0
  )
)

 ;|
mx:Variant2List
|;
(defun mx:Variant2List (var)
  (vlax-safearray->list
    (vlax-variant-value var)
  )
)

 ;|
Converts Degree angles into Radian angles
|;
(defun deg2rad (a)
  (* pi (/ a 180.0))
)

 ;|
mx:PercentPolar
|;
(defun mx:PercentPolar (l)
  (polar
    (car l)
    (angle (car l) (cadr l))
    (*
      (/ (last l) 100)
      (distance (car l) (cadr l))
    )
  )
)

 ;|
Systemvariable OSMODE einschalten
|;
(defun mx:OsmodeOn ()
  (if
    (< 16384 (getvar "OSMODE"))
     (setvar "OSMODE" (- (getvar "OSMODE") 16384))
  )
)

 ;|
Systemvariable OSMODE ausscshalten
|;
(defun mx:OsmodeOff ()
  (if
    (< 0 (getvar "OSMODE") 16384)
     (setvar "OSMODE" (+ (getvar "OSMODE") 16384))
  )
)

;;
;; Feedback beim Laden
(princ
  "\n\"acm-OFaMo.lsp\" wurde geladen. Copyright M.Hoffmann, www.CADmaro.de.
Start an jeder Punktabfrage als transparente Befehle mit Hochkommas: \"'%\", \"'lw\", \"'rl\", bzw. \"'l2\"."
)
(princ)