[Student]

В С Е Х С Н О В Ы М Г О Д О М ! ! !

У меня такой вопрос: можно ли как-то сделать сплайн полилинией, чтобы так же как и в полилинии задавать Widht, делать его общим целым с другимит примитивами... ?

[Startrek]

Skachal is CADALISTA rabotaet ili net ne znaju ne proverjal
tak chto DERZAI Student
S Novim Godom




;;CADALYST 12/03 AutoLISP Solutions SPLINE-TO-PLINE.LSP
;;(c) 2003 Tony Hotchkiss

(defun spline-to-pline (/ i)
(vl-load-com)
(setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
) ;_ end of vla-get-activedocument
*modelspace* (vla-get-ModelSpace *thisdrawing*)
) ;_ end of setq
(setq spline-list (get-spline))
(setq i (- 1))
(if spline-list
(progn
(setq msg "\nNumber of segments <100>: ")
(initget 6)
(setq num (getint msg))
(if (or (= num 100) (= num nil))
(setq num 100)
) ;_ end of if
(repeat (length spline-list)
(setq splobj (nth (setq i (1+ i)) spline-list))
(convert-spline splobj num)
) ;_ end of repeat
) ;_ end of progn
) ;_ end of if
) ;_ end of spline-to-pline

(defun get-spline (/ spl-list obj spline no-ent i)
(setq spl-list nil
obj nil
spline "AcDbSpline"
selsets (vla-get-selectionsets *thisdrawing*)
ss1 (vlax-make-variant "ss1")
) ;_ end of setq
(if (= (vla-get-count selsets) 0)
(setq ssobj (vla-add selsets ss1))
) ;_ end of if
(vla-clear ssobj)
(setq no-ent 1)
(while no-ent
(prompt "\nSelect splines: ")
(vla-Selectonscreen ssobj)
(if (> (vla-get-count ssobj) 0)
(progn
(setq no-ent nil)
(setq i (- 1))
(repeat (vla-get-count ssobj)
(setq
obj (vla-item ssobj
(vlax-make-variant (setq i (1+ i)))
) ;_ end of vla-item
) ;_ end of setq
(cond
((= (vlax-get-property obj "ObjectName") spline)
(setq spl-list
(append spl-list (list obj))
) ;_ end of setq
)
) ;_ end-of cond
) ;_ end of repeat
) ;_ end of progn
(prompt "\nNo entities selected, try again.")
) ;_ end of if
(if (and (= nil no-ent) (= nil spl-list))
(progn
(setq no-ent 1)
(prompt "\nNo splines selected.")
(quit)
) ;_ end of progn
) ;_ end of if
) ;_ end of while
(vla-delete (vla-item selsets 0))
spl-list
) ;_ end of get-spline

(defun convert-spline (splobj n / i)
(setq point-list nil
2Dpoint-list nil
z-list nil
spl-lyr (vlax-get-property splobj 'Layer)
startSpline (vlax-curve-getStartParam splobj)
endSpline (vlax-curve-getEndParam splobj)
i (- 1)
) ;_ end of setq
(repeat (+ n 1)
(setq i (1+ i))
(setq p (vlax-curve-getPointAtParam
splobj
(* i
(/ (- endspline startspline) n)
) ;_ end of *
) ;_ end of vlax-curve-getPointAtParam
) ;_ end of setq
(setq 2Dp (list (car p) (cadr p))
2Dpoint-list (append 2Dpoint-list 2Dp)
point-list (append point-list p)
z (caddr p)
z-list (append z-list (list z))
) ;_ end of setq
) ;_ end of repeat
(setq summ (apply '+ z-list))
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble ; element type
(cons 0
(- (length point-list) 1)
) ; array dimension
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq vert-array (vlax-safearray-fill arraySpace point-list))
(vlax-make-variant vert-array)
(if (and (= :vlax-true (vlax-get-property splobj 'IsPLanar))
(= summ 0.0)
) ;_ end of and
(setq plobj (add-polyline
2Dpoint-list
vla-AddLightweightPolyline
) ;_ end of add-polyline
) ;_ end of setq
(setq plobj (add-polyline
point-list
vla-Add3DPoly
) ;_ end of add-polyline
) ;_ end of setq
) ;_ end of if
(vlax-put-property plobj 'Layer spl-lyr)
(vla-delete splobj)
(vlax-release-object splobj)
) ;_ end of convert-spline

(defun add-polyline (pt-list poly-func)
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble
(cons 0
(- (length pt-list) 1)
) ; array dimension
) ;_ end of vlax-make-safearray
) ;_ end of setq
(setq vertex-array
(vlax-safearray-fill arraySpace pt-list)
) ;_ end of setq
(vlax-make-variant vertex-array)
(setq plobj (poly-func
*modelspace*
vertex-array
) ;_ end of poly-func
) ;_ end of setq
) ;_ end of add-polyline

(defun c:s2p ()
(spline-to-pline)
(princ)
) ;_ end of c:s2p

(prompt
"SPLINE-TO-PLINE by Tony Hotchkiss. Enter S2P to start"
) ;_ end of prompt

[Student]

To Startrek БИГ СЕНКС!!!!!

А есть что-то подобное например из елипса или круга в полилинию?

Дай пожалуйста ссылочку на CADALIST.

Ещо раз спасиба.

[Startrek]

Дорогой Студент иди гуляй, встречай Новый Год
а ссылочка вот держи http://www.cadonline.com

[Startrek]

Круг разбей на две ARC а потом PEDIT>Y>JOIN
a вот с эллипсом не знаю что делать

[Startrek]

Ах нашёл ответ - засади PELLIPSE = 1 рисуй эллипс теперь его можно EXPLODE
а потом PEDIT, хоть и муторно но работает, только потом не забудь PELLIPSE = 0
Вот пока все что смог придумать. :roll:

[Vova]

Вы уже за столом, а у нас рабочее время... А Startrek в Сиэттле, наверное, проснулся недавно... Про эллипс здесь: http://autokad.ru/forum/viewtopic.php?t=522 Про spline to pline тоже где-то здесь на форуме.
Админ: про Поиск здесь говорили. Не получилось найти ни по слову Эллипс, ни по слову PELLIPSE, которое я взял оттуда как ключевое

[Student]

Всем большое спасиба за помощ

[Сметанка]

http://autokad.ru/forum/viewtopic.php?t=448

[Startrek]

Агррр.... нашел еще один способ превращения SPLINE to PLINE
В акаде 2002/2004 COPY and PASTE SPLINE в пустой чертеж и сохраните под каким-нибудь
именем как R12 DXF. DXFIN его в ваш чертеж EXPLODE and PEDIT

[Сметанка]

что-то, однако, не получается...

[Arkady]

Код:

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

(defun dxf (code elist / ret)
  (cond
    ((= (type elist) 'LIST) (setq ret (cdr (assoc code elist))))
    ((= (type elist) 'ENAME)
     (setq ret (cdr (assoc code (entget elist))))
    )
    (T (setq ret nil))
  )
  ret
)


(defun c:spl2pl	()
  (setq spl (entsel "\nPick spline :"))
  (if spl
    (progn
      (if (= (dxf 0 (car spl)) "SPLINE")
	(progn
	  (setq spl_el (entget (car spl)))
	  (setq po1 (dxf 10 spl_el))
	  (setq ll (length spl_el))
	  (setq no 0)
	  (repeat ll
	    (setq item (nth no spl_el))
	    (setq no (1+ no))
	    (if	(= (car item) 10)
	      (setq po_last (cdr item))
	    )

	  )
	  (command "AREA" "E" spl)
	  (setq spl_len (getvar "PERIMETER"))
	  (if (not l_seg)
	    (setq l_seg 1.0)
	  )
	  (setq
	    tmp	(getreal
		  (strcat "\nLength of this spline is "
			  (rtos spl_len 2 2)
			  ";Enter Segment length for making POLYLINE"
			  " <"
			  (rtos l_seg 2 2)
			  "> :"
		  )
		)
	  )
	  (if tmp
	    (setq l_seg tmp)
	  )
	  (setq spl (list (car spl) po1))
	  (setq blp_mode (getvar "BLIPMODE"))
	  (setvar "BLIPMODE" 0)
	  (command "UNDO" "GROUP")
	  (command "MEASURE" spl l_seg)
	  (setq ssl (ssget "P"))
	  (setq ll (sslength ssl))
	  (setq no 0)
	  (setq po_lst (list po1))
	  (repeat ll
	    (setq item (ssname ssl no))
	    (setq no (1+ no))
	    (setq po_lst (append po_lst (list (dxf 10 item))))
	  )
	  (setq po_lst (append po_lst (list po_last)))
	  (command "ERASE" ssl "")
          (setq osmode (getvar "OSMODE"))
          (setvar "OSMODE" 0)
	  (command "PLINE")
	  (foreach n po_lst (command n))
	  (command "")
          (setvar "OSMODE" osmode) 
	  (setvar "BLIPMODE" blp_mode)
	  (initget "Yes No")
	  (setq word (getkword "\nErase Spline object ? No/<Yes>"))
	  (if (/= word "No")
	    (command "ERASE" spl "")
	  )
	  (command "UNDO" "END")
	)
      )


    )
  )

  (princ)
)