Pomiar długości krzywej – praktycznie

Praktyczny przykład zastosowania LISP-a do automatyzowania czynności. Tutaj pomiar długości krzywej reprezentującej dowolne medium, pomiedzy wskazanymi punktami określajacymi granice działek na mapie geodezyjnej. Zdefiniowane polecenie wymaga wybrania mierzonej linii (tutaj polilinii), oraz kolejno wskazywania punktów (podobnie jak w poleceniu tworzącym wymiary szeregowe). Pomiędzy wskazanymi punktami wstawiany jest tekst z wartością będącą zmierzoną długością. Działanie ilustruje poniższa animacja:

Krótki kod programu wymaga wcześniejszego załadowania CADPL-Pack’a, a całość wygląda tak:

; ------------------------------------------------------------------------- ;
; by kojacek - 2021                                                         ;
; ------------------------------------------------------------------------- ;
(defun C:DLK (/ :addanno :measure :getdist :getpoints :selcurve)
  (defun :addanno (Pts Val Lay Col / h a b x d i)
    (setq h (getvar "TEXTSIZE")
          a (car Pts)
          b (cadr Pts)
          x (angle a b)
          d (* 0.5 (distance a b))
          i (polar a x d)
    )
    (cd:ENT_MakeText
      (getvar "CTAB") Val i h 0.0
    )
  )
  (defun :measure (/ l p d u)
    (if
      (setq l
        (:selcurve
          "\nWybierz krzywą:"
          (list "LINE" "LWPOLYLINE" "SPLINE" "ARC")
        )
      )
      (progn
        (cd:SYS_UndoBegin)
        (redraw l 3)
        (while
          (setq p (:getpoints (cadr p)))
          (progn
            (setq d
              (cd:CON_Real2Str (:getdist p l) 2 2)
                  u (cdr (assoc 8 (entget l)))
            )
            (:addanno p d u 2)
          )
        )
        (redraw l 4)
        (cd:SYS_UndoEnd)
      )
      (princ "\nNie wskazano poprawnej krzywej.")
    )
  )
  (defun :getdist (Pts Ename / a b r)
    (setq a (osnap (car Pts) "_nea")
          b (osnap (cadr Pts) "_nea")
    )
    (setq r
      (abs
        (-
          (vlax-curve-getDistAtPoint Ename a)
          (vlax-curve-getDistAtPoint Ename b)
        )
      )
    )
  )     
  (defun :getpoints (In / s e)
    (if
      (if In
        (setq s In)
        (setq s (getpoint "\nWskaż pierwszy punkt pomiaru:"))
      )
      (if
        (setq e (getpoint s "\nNastępny punkt:"))
        (if
          (not
            (equal s e 0.01)
          )
          (list s e)
        )
      )
    )
  )
  (defun :selcurve (Msg Lst / e)
    (if
      (and
        (setq e (car (entsel Msg)))
        (member
          (cdr (assoc 0 (entget e)))
          Lst
        )
      ) e
    )
  )
  (:measure)
  (princ)
)
; ------------------------------------------------------------------------- ;

O pomiarze długości krzywej pisałem już jakiś czas temu tutaj. Warto zauważyć że kod w wielu miejscach jest niemal taki sam.

To jest wpis numer: 207

( . . . )