[Sergiy]

Кманда List выдает на экран координаты центра и радиус для дугового сегмента полилинии. Как получить эти параметры программно?

[VVA]

Код:

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

;;;* Ф-ция _pline-get-radii
;;;* Возвращает радиус дугового сегмента полилинии
;;;* get bulge radius
;;;* math by Juergen Menzi
;;;* Arguments [Type]:
;;;   p1 = Point [LIST] - точка начала сегмента
;;;   p2 = Point [LIST] - точка конца сегмента
;;; bulge = кривизна
;;;* Возвращает [Type]:
;;;   радиус [Real]
(defun lib:pline-get-radii  (p1 p2 bulge)
 (if (not(zerop bulge))   
  (abs (/ (/ (distance p1 p2) 2.0)
    (sin (* 2.0 (atan bulge)))))
     0.0))
;|=======================================================================================
* Ф-ция lib:pline-get-segm-center
* Возвращает координаты цетнра дугового сегмента полилинии
* Arguments [Type]:
   pline = Object [Vla-Object]
      p1 = Point [LIST] - точка начала сегмента
      p2 = Point [LIST] - точка конца сегмента
   bulge = кривизна
* Возвращает [Type]:
   список координат [Real]
|; 
(defun lib:pline-get-segm-center  (pline p1 p2 bulge / cpt midc midp rad)
(setq rad (lib:pline-get-radii p1 p2 bulge)
      midp (vlax-curve-getpointatparam pline
       (+ (fix (vlax-curve-getparamatpoint pline p1)) 0.5))
      midc (mapcar (function (lambda (x y)(/ (+ x y) 2))) p1 p2)
      cpt (trans (polar midp (angle midp midc) rad) 0 1)
)
cpt
)

(defun C:PL-SgInfo ( / dis ent fpar pickpt spar pline curpt blglist blg rad cen p1 p2 str isRus *error*) 
(vl-load-com)(setq *error* pltool-err)
(setq isRus (= (getvar "DWGCODEPAGE") "ANSI_1251"))
(while (setq ent (entsel
  (if isRus
     "\nУкажите точку на интересующем сегменте (Enter - выход): "
     "\nPick segment point to be dimensioned (or press Enter to exit loop) : "))) 
(setq vobj (vlax-ename->vla-object (car ent))) 
(setq pickpt (trans (cadr ent) 1 0)) 
(setq curpt (vlax-curve-getclosestpointto vobj pickpt)) 
(setq fpar (1+ (fix (vlax-curve-getparamatpoint vobj curpt))) 
      spar (1- fpar)) 
(setq dis (distance 
   (setq p2 (vlax-curve-getpointatparam vobj fpar)) 
   (setq p1 (vlax-curve-getpointatparam vobj spar)))) 
(setq blglist (getblg (car ent)) blg (nth spar blglist)) 
(setq rad (lib:pline-get-radii p1 p2 blg)) 
(setq cen (lib:pline-get-segm-center vobj p1 p2 blg))
(if isRus
(princ "\n\n**** Информация о сегменте: ****\n")   
(princ "\n\n**** Segment info: ****\n"))
(if isRus  
(setq str (strcat "№ сегмента : " (VL-PRINC-TO-STRING fpar) 
"\nДлина сегмента: " (rtos dis 2 5)
"\nРадиус: "  (rtos rad 2 5) 
"\nЦентр сегмента в МСК: "(VL-PRINC-TO-STRING cen) 
"\nНачало сегмента в МСК: "(VL-PRINC-TO-STRING p1) 
"\nКонец сегмента в МСК: "(VL-PRINC-TO-STRING p2)))
(setq str (strcat "Segment number : " (VL-PRINC-TO-STRING fpar) 
"\nSegment length is: " (rtos dis 2 5) " metric dwg units" 
"\nRadius: "  (rtos rad 2 5) 
"\nSegment center point in WCS: "(VL-PRINC-TO-STRING cen) 
"\nSegment start point in WCS: "(VL-PRINC-TO-STRING p1) 
"\nSegment end point in WCS: "(VL-PRINC-TO-STRING p2)))
  )
(princ str)(alert str))(princ))

[Sergiy]

Спасибо!

[pvetal]

СПАСИБО!!!, искал несколько дней это