Region -> closed polyline

Region -> closed polyline · 21.11.2005, 19:19

Есть солид с него командой SECTION получен срез (region), и вопрос как минимальными действиями сделать из него замкнутую полилинию или несклоько полилиний, если регион с дырками?

Den_Den · 09.03.2009, 21:55

Сорри.... не сразу нашел...

VVA · 10.03.2009, 10:22

Пробуй. Особо не проверял.

Код:

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

(defun c:retopl1 (/	   *error*  oldEcho  Ent      curSet   newObj
		  curObj   ObjArr   curMemb  errFlag  actDoc   item
		  ss
		 )
  (vl-load-com)

  (defun *error* (msg)
    (vla-EndUndoMark actDoc)
    (setvar "CMDECHO" oldEcho)
    (princ msg)
    (princ)
  ) ;_ end of *error*

  (setq	oldEcho	(getvar "CMDECHO")
	actDoc
		(vla-get-ActiveDocument
		  (vlax-get-acad-object)
		)
  ) ;_ end setq
  (vla-StartUndoMark actDoc)
  (setvar "CMDECHO" 0)
  (setvar "UCSFOLLOW" 0)
  (if (setq ss (ssget "_X"
		      (list '(0 . "REGION")
			    (cons 410 (getvar "CTAB"))
		      )
	       )
      )
    (repeat (setq item (sslength ss))
      (setq Ent	   (ssname ss (setq item (1- item)))
	    curObj (vlax-ename->vla-object Ent)
      )
      (if (vlax-write-enabled-p curObj)
	(progn
	  (setq	curSet nil
		curSet (ssadd)
		newObj (vla-Copy curObj)
		ObjArr (vlax-safearray->list
			 (vlax-variant-value
			   (vla-Explode newObj)
			 )
		       )
	  )
	  (foreach memb	ObjArr
	    (setq memb (vlax-vla-object->ename memb))
	    (if	(member
		  (cdr (assoc 0 (entget Memb)))
		  '("LINE" "ARC" "LWPOLYLINE")
		)
	      (setq curSet (ssadd Memb CurSet))
	    ) ;_ end if
	  ) ;_ end foreach 
	  (if (> (sslength curSet) 0)
	    (progn
	      (command "_.ucs" "_ob" (ssname curSet 0))
	      (if (and (getvar "PEDITACCEPT")
		       (= (getvar "PEDITACCEPT") 1)
		  )
		(command "_.pedit" (ssname curSet 0) "_j" CurSet "" "")
		(command "_.pedit"
			 (ssname curSet 0)
			 "_y"
			 "_j"
			 CurSet
			 ""
			 ""
		)
	      )
	      (while (> (getvar "CMDACTIVE") 0) (command ""))
	      (command "_.ucs" "_p")
	      (vla-delete curObj)
	      (princ "\n<<< Polyline created:) >>>")
	    ) ;_ end progn
	    (progn
	      (command "_.erase" curSet "")
	      (vla-EndUndoMark actDoc)
	      (alert "Can't transform this Region to Polyline!")
	    ) ;_ end progn
	  ) ;_ end if
	) ;_ end progn
      ) ;_ end if
    ) ;_ end repeat
  )
  (setvar "CMDECHO" oldEcho)
  (vla-EndUndoMark actDoc)
  (princ)
) ;_ end of c:retopl

Павел Котелевец · 07.04.2011, 02:21

Роскошный лисп!
Взялся за допил.

Результат:

Предлагает выбор
Обработал все тестовые регионы (простой/с вычетом/суммарный/суммарный с вычетом/ тот же набор, но с содержанием сплайнов) за один вызов команды.
Все осколки, способные объединятся, объединяет в полилинии.
Удаляет исходные регионы.
PEDITACCEPT ставит 1. (В 0 не нашёл смысла)

Название рабочее =)

Код:

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

 (defun c:r2 (/	   *error*  oldEcho  Ent      curSet   ;2:04 07.04.2011 Retopl mod by 1D
		  curObj   ObjArr   curMemb  errFlag  actDoc   item
		  ss MT i MT1 ss1
		 )
  (vl-load-com)

  (defun *error* (msg)
    (vla-EndUndoMark actDoc)
    (setvar "CMDECHO" oldEcho)
    (princ msg)
    (princ)
  ) ;_ end of *error*

(defun r2plc (ss / );

(setq i 0); chesk curSet selset for empty entries
(repeat (sslength ss)
             (if
             (not (vlax-ename->vla-object (ssname ss i)))
             (setq ss (ssdel (ssname ss i) ss)))
		(setq i (1+ i))
);repeat

(setq Ent (ssname ss (setq item (1- item))));___ entity
(setq curObj (vlax-ename->vla-object Ent)); ___VLA entity
  
(if (vlax-write-enabled-p curObj)
(progn
	  (setq	curSet nil
		curSet (ssadd)
		ObjArr (vlax-safearray->list
			 (vlax-variant-value
			   (vla-Explode curObj)
			 )
		       )
	  )
		(vla-delete curObj); ___explode to ObjArr


	  (foreach memb	ObjArr
	    (setq memb (vlax-vla-object->ename memb))
	    (if	(member
		  (cdr (assoc 0 (entget Memb)))
		  '("LINE" "ARC" "LWPOLYLINE")
		)
	      (setq curSet (ssadd Memb CurSet));___Curset from linearc chunks
	    ) ;_ end if


(if (member
 (cdr (assoc 0 (entget Memb)))
 '("REGION")
 )
   (progn 	      
   (setq ss1 (ssadd Memb ss1));___ss1 from Reg
   )
);if

	  ) ;_ end foreach 

(if (> (sslength ss1) 0)
(setq i 0); chesk ss1 selset for empty entries
(repeat (sslength ss1)
             (if
             (not (vlax-ename->vla-object (ssname ss1 i)))
             (setq ss1 (ssdel (ssname ss1 i) ss1)))
             (setq i (1+ i))
             ));___clean ss1

(if (> (sslength curSet) 0)
(setq i 0); chesk curSet selset for empty entries
(repeat (sslength curSet)
             (if
             (not (vlax-ename->vla-object (ssname curSet i)))
             (setq curSet (ssdel (ssname curSet i) curSet)))
		(setq i (1+ i))
             ));___clean curset


(if (> (sslength curSet) 0)
	    (progn
		(command "_.ucs" "_ob" (ssname curSet 0))
		(command "_.pedit" (ssname curSet 0) "_j" CurSet "" "")
	      (while (> (getvar "CMDACTIVE") 0) (command ""))
	      (command "_.ucs" "_p")


		(setq MT curSet i 0)
(repeat (sslength MT)
(setq MT1 (ssname MT i))
(setq i (1+ i)
VSS (ssadd MT1 VSS))
)

;;(command "_.chprop" MT "" "_C" 12 "")

(princ "\n<<< Polyline created: >>>")
) ;_ end progn
);if
	  
) ;_ end progn
);if
);defun r2plc

; MAIN PART

(setq oldEcho (getvar "CMDECHO") actDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark actDoc)
(setvar "CMDECHO" 0)
(setvar "PEDITACCEPT" 1)
(setvar "UCSFOLLOW" 0)
(setq VSS nil VSS (ssadd)); lines/arc chunks collector
(setq ss1 nil ss1 (ssadd)); complex region's chunks collector
(princ "select regions")

(if (setq ss (ssget 
;"_X"
    (list '(0 . "REGION") (cons 410 (getvar "CTAB")))));setq
(progn
        (repeat (setq item (sslength ss))
        (r2plc ss));repeat
        
        (if (> (sslength ss1) 0)
            (progn
            (princ "\nAddictive Regions:")
            (princ (sslength ss1))
                 (repeat (setq item (sslength ss1))
                 (r2plc ss1));repeat
            ) ;_ end progn
        );if

);progn
);if

(setq i 0); chesk VSS selset for empty entries and joining chunks
(repeat (sslength VSS)
             (if
             (vlax-ename->vla-object (ssname VSS i))
             (vl-cmdf "_PEDIT" "_M" VSS "" "_J" "_J" "_B" 0 "")
             )
             (setq i (1+ i))
);repeat

(princ "\nComplete")
  (setvar "CMDECHO" oldEcho)
  (vla-EndUndoMark actDoc)
  (princ)
) ;_ end of c:r2pl

Павел Котелевец · 05.11.2012, 18:30

В результате: объединение полилиний:

Код:

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

 (defun C:R11 (/; convert to reg bylayer and union
ss MT MTL i MT1
)
(princ "\nObj for reg")

(setq ss (ssget 
'((-4 . "<OR")(0 . "*POLYLINE") (0 . "*REGION") (0 . "*CIRCLE")(-4 . "OR>"))
))
(setq i 0 vs (ssadd))
(repeat (sslength ss)
(setq MT (ssname ss i))
(if (member (cdr (assoc 0 (entget MT))) '("POLYLINE" "LWPOLYLINE" "CIRCLE")  )
(progn
(setq MTL (cdr (assoc 8 (entget MT))))
(setvar "CLAYER" MTL)
(command "_REGION" MT "")
(setq MT1 (entlast))
(if (and (= (cdr (assoc 0 (entget MT1))) "REGION") (not (ssmemb MT1 vs)))
(setq vs (ssadd MT1 vs))
))
(setq vs (ssadd MT vs))
)
(setq i (1+ i))
(princ i)
)
(command "_UNION" vs "")
(sssetfirst vs vs)
(C:R2)
(princ))
(princ "\n R11        _loaded: Convert to REGION bylayer and JOIN")
(setq MT (1+ MT))

Вычитание полилиний:

Код:

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

 (defun C:R22 (/; convert to reg bylayer and SUBTRACT
ss MT MTL i MT1 OSM MTE
)
(princ "\nTEST_VERSION !!")

(princ "\nSubtract FROM:")
(setq vs (ssget 
'((-4 . "<OR")(0 . "*POLYLINE") (0 . "*REGION")(-4 . "OR>"))
))
(princ "\nSubtract by THIS:")
(setq ss (ssget 
'((-4 . "<OR")(0 . "*POLYLINE") (0 . "*REGION")(-4 . "OR>"))
))

(setq MTE (entlast) vsss (ssadd))

(setq OSM (getvar "OSMODE"))
(setvar "OSMODE" 0)
(command "_COPY" ss "" "@" "@")
(setvar "OSMODE" OSM)


(while MTE 
(setq MTE (entnext MTE))
(if MTE (setq vsss (ssadd MTE vsss)))
)

(setq i 0)
(repeat (sslength vs)
(setq MT (ssname vs i))
(if (member (cdr (assoc 0 (entget MT))) '("POLYLINE" "LWPOLYLINE")  )
(progn
(setq MTL (cdr (assoc 8 (entget MT))))
(setvar "CLAYER" MTL)
(command "_REGION" MT "")
(setq MT1 (entlast))
(if (and (= (cdr (assoc 0 (entget MT1))) "REGION") (not (ssmemb MT1 vs)))
(setq vs (ssadd MT1 vs))
))
(setq vs (ssadd MT vs))
)
(setq i (1+ i))
(princ i)
)


(setq i 0 vss (ssadd))
(repeat (sslength ss)
(setq MT (ssname ss i))
(if (member (cdr (assoc 0 (entget MT))) '("POLYLINE" "LWPOLYLINE")  )
(progn
(setq MTL (cdr (assoc 8 (entget MT))))
(setvar "CLAYER" MTL)
(command "_REGION" MT "")
(setq MT1 (entlast))
(if (and (= (cdr (assoc 0 (entget MT1))) "REGION") (not (ssmemb MT1 vss)))
(setq vss (ssadd MT1 vss))
))
(setq vss (ssadd MT vss))
)
(setq i (1+ i))
(princ i)
)

(command "_SUBTRACT" vs "" vss "")
(sssetfirst vs vs)
(C:R2)
(setq vss vsss)
(sssetfirst vss vss)
(princ)


(setq i (getstring "\n Delete?"))
(command "_ERASE" vss "")

)
(princ "\n R22        _loaded: Convert to REGION bylayer and cut SUTRACT")

21.11.2005, 19:19
Region -> closed polyline asys архитектор Ростов-на-Дону Регистрация: 10.08.2005 Сообщений: 5,295 Есть солид с него командой SECTION получен срез (region), и вопрос как минимальными действиями сделать из него замкнутую полилинию или несклоько полилиний, если регион с дырками?
Просмотров: 9526

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск

	Реклама i