Отмерить по линии расстояние и поставить точку (Страница 2 из 4)

;;---------------------------------   Dist2p.lsp   ------------------------------------;; 

;; fixo () 2011 * all rights released (типа делай с ней что хошь) 
;; редакция от 2/16/12 
;; редакция от 2/21/12 
(defun c:dist2p ( / *error* a b box dimbl dimz dist1 dist2 elist ht mp1 mp2 p1 p2 p3 par1 par2 plent pline pt1 pt2 sp txt wid)
  (defun *error* (msg)
    (cond ((not msg))
      ((vl-position
         msg
         '("Function cancelled" "quit / exit abort" "console break")
       )
      )
      ((princ (strcat "\nDist2P Command Error: " msg)))
    )
    (if    dimbl
      (setvar "dimldrblk" dimbl)
    )
    (if    dimz
      (setvar "dimzin" dimz)
    )
    (command "_undo" "_end")
    (princ)
  )


  (command "_undo" "_begin")
  (setq dimbl (getvar "dimldrblk"))
  (setvar "dimldrblk" ".")
  (setq dimz (getvar "dimzin"))
  (setvar "dimzin" 0)
  (prompt "\n    >>>  ВЫБРАТЬ КРИВУЮ >>>\n")
  (setq sp nil)
  (while (not (or (and (setq sp (ssget "_+.:S:E" '((0 . "*line")))))))
    (princ "\n\t--->   ВЫБРАТЬ ТОЛЬКО КРИВУЮ!"))
  (setq    plent (ssname sp 0)
    pline (vlax-ename->vla-object plent)
  )
    (while (setq p1 (getpoint "\nПервая точка на кривой (или Enter для завершения): "))
         
    
      (progn
    (setq p2 (getpoint p1 "\nВторая точка на кривой: "))
   (while (member (car (setq p3 (grread t 15 0))) '(5 2))
     (redraw)
     (if (listp (setq p3 (cadr p3)))
       (progn
     (grdraw p1 p3  1 1)
     (grdraw p2 p3  1 1)

       )
     )
   )
   (setq p3 (cadr p3))

   (setq p1 (vlax-curve-getclosestpointto pline p1))
   (setq par1 (vlax-curve-getparamatpoint pline p1))
   (setq dist1 (vlax-curve-getdistatparam pline par1))
   (setq mp1 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p3))
   (setq p2 (vlax-curve-getclosestpointto pline p2))
   (setq par2 (vlax-curve-getparamatpoint pline p2))
   (setq dist2 (vlax-curve-getdistatparam pline par2))
   (setq mp2 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 p3))
   (setq txt (rtos (abs (- dist1 dist2)) 2 3));<-- точность 3 знака, изменить по условию


    (setq elist
           (list
         '(0 . "TEXT")
         '(100 . "AcDbEntity")
         '(67 . 0)
         '(410 . "Model")
         '(8 . "0")
         '(100 . "AcDbText")
         (cons 10 p3)
         (cons 11 (list (car p3) (+ (cadr p3) (/ (* (getvar "textsize")(getvar "dimscale")) 2)) 0.0))
         (cons 40 (* (getvar "textsize")(getvar "dimscale")))
         (cons 1 txt)
         '(50 . 0.0)
         '(41 . 1.0)
         '(51 . 0.0)
         (cons 7 (getvar "textstyle"))
         '(71 . 0)
         '(72 . 0)
         (cons 210 (list 0.0 0.0 1.0))
         '(73 . 2)
           )
    )

(setq box (textbox elist))
(setq pt1 (car box)
      pt2 (cadr box)
      wid (- (car pt2) (car pt1))
      ht  (- (cadr pt2) (cadr pt1))
      pt1 (list (- (car pt1) (/ ht 2.0)) (+ (cadr pt1) (/ ht 2.0)) (caddr pt1))
      pt2 (list (+ (car pt2) (/ ht 2.0)) (cadr pt1) (caddr pt1))
      pt1 (mapcar '+ pt1 p3)
      pt2 (mapcar '+ pt2 p3)
)

   (command "_.acad_dim.mleader" p1 pt1 "")
    (vla-put-textstring
      (vlax-ename->vla-object (setq mldr(entlast)))
      txt)
(command "_mleaderedit" "_L" "" "_A" p2 "")
(command "_chprop" "_L" "" "_Color" "2" "");<-- цвет ("2") измени здесь

    )
      (redraw)
      )
    
  (*error* nil)
  (princ)
)
(prompt "\n   ---   Команда на выполнение \"DIST2P\" или \"dist2p\"  ---") 
(prin1) 
(or (vl-load-com) 
(princ) 
    ) 
;;---------------------------------   Dist2p.lsp   ------------------------------------;;