[shinyur]

есть необходимость преобразовать все окружности и дуги на четеже (около 1000шт) в отрезки.
чтото вроде команды взорвать которая взрывает дуги и окружности.
что получается вписанный многоугольник или описанный не столь важно. но желательно чтобы количество сегментов выбиралось (например 12)
может у кого есть готовый lisp. не смог найти.
я так понимаю с окружностями всё довльно просто - с дугами сложнее?

[VVA]

Преобразовать дуги в полилинии (PL-JOIN), затем PL-NoArc с опцией количество сегментов N

Команда: PL-NoArc Выберите режим апроксимации дуговых сегментов [количество сегментов N/длина сегмента L/предельное отклонение хорды S/длина хорды C/помощь H]:N

[shinyur]

спасибо!
а как насчёт окружностей?
её нужно сперва как то преобразовать в полилинию?
или сперва в дугу, а потом в полилинию?

[VVA]

shinyur,
1. C помощью

ConvTo2d -Преобразование криволинейных объектов в 2D полилинии

можешь сразу преобразовать в полилинии, но без указания количесва сегментов.
2. Можно в дугу, затем в полилинию
3. Посмоти TotalPurge

Программа TotalPurge позволяет конвертировать примитивы AutoCAD в полилинии. Программа преобразует в полилинии следующие типы объектов: ACR, CIRCLE, LINE, SPLINE, ELLIPSE, POLYLINE.

4. Тщательнее поискать в интернете (не только русскоязычном)
Например, если спросить у googl'a про circle into arc, то можно найти программы gile

Код:

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

;; A2PG (gile)
;; Convert arcs and circles in polygons

(defun c:a2pg (/ ss n n_seg obj dist pt_lst nb)
  (prompt
    "\nSelect arcs and circles to be converted <all>."
  )
  (if (not (setq ss (ssget '((0 . "ARC,CIRCLE")))))
    (setq ss (ssget "_X" '((0 . "ARC,CIRCLE"))))
  )
  (initget 7)
  (setq n_seg (getint "\nNumber of segments: "))
  (repeat (setq n (sslength ss))
    (setq obj	 (vlax-ename->vla-object (ssname ss (setq n (1- n))))
	  dist	 (/ (vlax-curve-getDistAtParam
		      obj
		      (vlax-curve-getEndParam obj)
		    )
		    n_seg
		 )
	  norm	 (vlax-get obj 'Normal)
	  pt_lst (list (vlax-curve-getEndPoint obj))
	  nb	 n_seg
    )
    (repeat n_seg
      (setq
	pt_lst (cons (vlax-curve-getPointAtDist
		       obj
		       (* dist (setq nb (1- nb)))
		     )
		     pt_lst
	       )
      )
    )
    (if	(= (vla-get-ObjectName obj) "AcDbCircle")
      (setq pt_lst (reverse (cdr (reverse pt_lst))))
    )
    (setq elev	 (- (caddr (trans (car pt_lst) 0 norm))
		    (caddr (trans '(0 0) 0 norm))
		 )
	  pt_lst (apply	'append
			(mapcar	'(lambda (pt)
				   (setq pt (trans pt 0 norm))
				   (list (car pt) (cadr pt))
				 )
				pt_lst
			)
		 )
    )
    (setq pline
	   (vlax-invoke
	     (vla-get-ModelSpace
	       (vla-get-ActiveDocument (vlax-get-acad-object))
	     )
	     'addLightWeightPolyline
	     pt_lst
	   )
    )
    (vlax-put pline 'Normal norm)
    (vla-put-elevation pline elev)
    (if	(= (vla-get-ObjectName obj) "AcDbCircle")
      (vla-put-closed pline :vlax-true)
    )
    (vla-delete obj)
  )
  (princ)
)

или FIXO (нужное выделили красным)

Код:

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

;;; acl.lsp
;;; 11/6/05
;;; convert arcs and circles to line segments
;;; local defun
;; http://forums.augi.com/showthread.php?t=79610

(defun arctolines (acsp obj n / cnt d leng p pts s x y)
  (setq d (/ (setq leng (vla-get-arclength obj)) n)
	s d)
  (setq cnt 0)
	(while (<= (- d s) leng)
	  (setq p (vlax-curve-getclosestpointto obj
		    (vlax-curve-getpointatdist obj (* s cnt))))
	  (setq pts (cons p pts))
	  (setq cnt (1+ cnt))
	  (setq d (+ d s))
	  )
  (mapcar (function (lambda (x y)(vlax-invoke acsp 'AddLine x y)))
	  pts (cdr pts)
	  )
  (vla-delete obj)
  )
;;local defun
(defun circletolines (acsp obj n / cnt d leng p pts s x y)
  (setq d (/ (setq leng (vla-get-circumference obj)) n)
	s d)
  (setq cnt 0)
	(while (<= (- d s) leng)
	  (setq p (vlax-curve-getclosestpointto obj
		    (vlax-curve-getpointatdist obj (* s cnt))))
	  (setq pts (cons p pts))
	  (setq cnt (1+ cnt))
	  (setq d (+ d s))
	  )
  (setq pts (cons (vlax-curve-getclosestpointto obj
		    (vlax-curve-getpointatdist obj 0.0))
		  pts)
	)
  (mapcar (function (lambda (x y)(vlax-invoke acsp 'AddLine x y)))
	  pts (cdr pts)
	  )
  (vla-delete obj)
  )

;;main part
;;http://forums.augi.com/showthread.php?t=79610
(defun C:ACL (/ acapp acsp adoc obj sset)
(vl-load-com)
  (or acapp
      (setq acapp (vlax-get-acad-object))
  )
  (or adoc
      (setq adoc (vla-get-activedocument acapp))
  )
(or acsp
      (setq acsp (if (= (getvar "CVPORT") 1)
		   (vla-get-paperspace
		     adoc)
		   (vla-get-modelspace
		     adoc)
		   )
	    )
      )
(vla-endundomark adoc)
(vla-startundomark adoc)


(setq sset (ssget "_X" '((0 . "ARC,CIRCLE"))))
(vlax-for obj (vla-get-activeselectionset adoc)
(if
  (eq "AcDbArc" (vla-get-objectname obj))
  (arctolines acsp  obj 12);<-- 12 is number of segments
  (circletolines acsp  obj 12);<-- 12 is number of segments
  )  
)

(vla-endundomark adoc)
(princ)
)
(princ "\n >> Start command with ACL")
(princ)

[CB]

Или так:

Код:

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

(defun c:test (/ sset n)
 (if (and (setq sset (ssget '((0 . "ARC,CIRCLE")))
                n    (getint "\nКоличество сегментов: ")
          ) ;_  setq
     ) ;_  and
  (mapcar
   '(lambda (obj / sp ep lst p)
     (setq obj (vlax-ename->vla-object obj)
           sp  (vlax-curve-getstartparam obj)
           ep  (vlax-curve-getendparam obj)
           lst (list (vlax-curve-getstartpoint obj))
           p   (/ (- ep sp) n)
     ) ;_  setq
     (repeat n
      (setq sp  (+ sp p)
            lst (cons
                 (vlax-curve-getpointatparam obj sp)
                 lst
                ) ;_  cons
      ) ;_  setq
     ) ;_  repeat
     (vla-delete obj)
     (entmakex
      (append
       (list '(0 . "LWPOLYLINE")
             '(100 . "AcDbEntity")
             '(100 . "AcDbPolyline")
             (cons 90 (length lst))
       ) ;_  list
       (mapcar (function (lambda (x) (cons 10 x)))
               lst
       ) ;_  mapcar
      ) ;_  append
     ) ;_  entmakex
    ) ;_  lambda
   (vl-remove-if
    (function listp)
    (mapcar (function cadr) (ssnamex sset))
   ) ;_ end of vl-remove-if
  ) ;_  mapcar
 ) ;_  if
 (princ)
) ;_  defun

[shinyur]

спасибо за подробный ответ.

вот мне ещё подкинули (полилиния из двух дуг по 180градусов получается)

Код:

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

 
(defun circle_to_pline( / el ss i e ins)
 (setq i 0  ss (ssget (list(cons 0 "circle"))))
 (if ss
  (progn
   (repeat (sslength ss)
       (setq el (ssname ss i))
       (setq e (entget el))
       (setq ins (cdr (assoc 10 e)))
       (setq rad (cdr (assoc 40 e)))
       (command "_.donut"  (* 2 rad)   (* 2 rad) ins "")
       (command  "_.erase" el "")
       (setq i (1+ i))
   );repeat
  );progn
 );if
);defun
(circle_to_pline)