[DEM]

Требуется лиспик экспорта 2d полилинии=>3d полилинии
С отрисовкой 3d полилинии на слое "3d полилинии" (слой существует)
Соединение полилиний не требуется.

[X-DeViL]

Код:

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

_explode

Вот тебе и лиспик

[DEM]

:twisted: Х-дьявол не флуди :twisted:

[Кулик Алексей aka kpblc]

Сообщение от X-DeViL Код: [Выделить все] _explode Вот тебе и лиспик

Фигушки. Ему ж надо 3д-полилинию
Дублирую с http://my.opera.com/kpblc/blog/show.dml/299368 :

Код:

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

(defun c:lwp-3dp (/ adoc selset vla_3dpoly pt_lst)

  (defun loc:kpblc-conv-2d-to-3d (lst / res item counter)
    (setq counter 0)
    (while (setq item (nth counter lst))
      (setq res       (append res (list (nth counter lst) (nth (1+ counter) lst) 0.))
       counter (+ 2 counter)
       ) ;_ end of setq
      ) ;_ end of while
    res
    ) ;_ end of defun

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (if (setq selset (ssget "_X" '((0 . "LWPOLYLINE"))))
    (foreach item (mapcar 'vlax-ename->vla-object
           (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
           ) ;_ end of mapcar
      (setq pt_lst     (loc:kpblc-conv-2d-to-3d
          (vlax-safearray->list
            (vlax-variant-value (vla-get-coordinates item))
            ) ;_ end of vlax-safearray->list
          ) ;_ end of loc:kpblc-conv-2d-to-3d
       vla_3dpoly (vla-add3dpoly
          (vla-objectidtoobject adoc (vla-get-ownerid item))
          (vlax-make-variant
            (vlax-safearray-fill
              (vlax-make-safearray
                vlax-vbdouble
                (cons 0 (1- (length pt_lst)))
                ) ;_ end of vlax-make-safearray
              pt_lst
              ) ;_ end of vlax-safearray-fill
            vlax-vbvariant
            ) ;_ end of vlax-make-variant
          ) ;_ end of vla-add3dpoly
       ) ;_ end of setq
      (foreach prop '("closed"      "layer"        "lineweight"
            "linetype"   "color"        "linetypegeneration"
            "elevation"   
            )
   (if (and (vlax-property-available-p item prop)
       (vlax-property-available-p vla_3dpoly prop t)
       ) ;_ end of and
     (vlax-put-property vla_3dpoly prop (vlax-get-property item prop))
     ) ;_ end of if
   ) ;_ end of foreach
      (vla-erase item)
      ) ;_ end of foreach
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

слои должны быть разблокированы и разморожены. Код корежит все полилинии файла, кроме входящих в блоки и внешние ссылки.

[VVA]

Почти тоже, но СИНИМИ БУКВАМИ

Код:

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

(defun C:2T3 ( / adoc ssnab lst pl pl3d clay)
(defun ZZeroList (lst)
    (mapcar '(lambda (p) (list (car p) (cadr p) 0.0)) lst)
  )
(defun get-pline-coors ( pl / ent_data tmp_ent coors)
 (defun dxf (n ent)(cdr (assoc n (entget ent))))
(defun massoc (key alist)
(mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist))) ;_ end of defun
(vl-load-com)
(if (= (type pl) 'VLA-OBJECT)(setq pl (vlax-vla-object->ename pl)))
  (setq ent_data (entget pl))
  (cond ((= (dxf 0 pl) "LWPOLYLINE")
   (setq coors (massoc 10 ent_data)))
  ((= (dxf 0 pl) "POLYLINE")
   (setq tmp_ent pl)
   (while (/= "SEQEND" (dxf 0 (setq tmp_ent (entnext tmp_ent))))
     (setq coors (append coors (list (dxf 10 tmp_ent))))
     )
   )
  (t (setq coors nil))
   )
  coors
  )
(setq adoc (vla-get-ActiveDocument(vlax-get-acad-object)))
(vla-StartUndoMark adoc)
(setq clay (getvar "CLAYER"))  
(setq ssnab (ssget '((0 . "*POLYLINE"))))
(if ssnab
  (progn
    (command "_.LAYER" "_M" "3d полилинии" "")
    (setq lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssnab)))))
    (setq pl (car lst))
    (foreach pl lst
      (if (member(vla-get-ObjectName pl) '("AcDb2dPolyline" "AcDbPolyline"))
	(progn
      (setq crs (get-pline-coors pl)
            crs (ZZeroList crs)
	    crs (apply 'append crs)
	    var (vlax-make-variant(vlax-safearray-fill(vlax-make-safearray
		vlax-vbDouble (cons 0 (1- (length crs)))) crs))
	    )
      
      (setq pl3d (vla-Add3DPoly (vla-ObjectIDToObject adoc (vla-get-OwnerID pl)) var))
      (vla-put-Closed pl3d (vla-get-Closed pl))
      
      )
	)
      )
    )
  )
  (setvar "CLAYER" clay)
  (vla-EndUndoMark adoc)
  (princ)
  )
(princ "\nType 2T3 in command line")

Не знаю, критично или нет, но обрабатывает и 2d полилинии (не только LW)

[Кочетков Андрей]

Если есть Land Desktop, то там есть соответствующая команда в пункте меню Terrain->3D Polyline

Аналогично в Тулпаке есть команда "2-3"

[DEM]

Спасибо огромное. с меня пыво