| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Лисп, создающий точки во всех узлах polyface mesh

Лисп, создающий точки во всех узлах polyface mesh

Ответ
Поиск в этой теме
Непрочитано 28.03.2005, 11:55 #1
Лисп, создающий точки во всех узлах polyface mesh
Torino
 
Штаб
Регистрация: 21.08.2003
Сообщений: 943

Очень нужен лисп, создающий точки во всех узлах polyface mesh.
Программисты, помогите, пожалуйста.
Просмотров: 3701
 
Непрочитано 28.03.2005, 12:43
#2
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 755


Код:
[Выделить все]
(defun pl:put-point-to-mesh (/ adoc asel space)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        asel (vla-get-activeselectionset adoc)
  )
  (vla-clear asel)
  (vla-endundomark adoc)
  (vla-startundomark adoc)
  (pl:obj-filter-select-manual asel '((0 . "POLYLINE") (100 . "AcDbPolygonMesh")))
  (if (not (zerop (vla-get-count asel)))
    (setq space (vla-objectidtoobject adoc (vla-get-ownerid (vla-item asel 0))))
  )
  (vlax-for i asel
    (foreach p (pl:lst-to-lsts
                 (vlax-safearray->list (vlax-variant-value (vla-get-coordinates i)))
                 3
               )
      (vla-addpoint space (vlax-3d-point p))
    )
  )
  (vla-clear asel)
  (vla-endundomark adoc)
)

(defun pl:obj-filter-select-manual (sel filter)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbinteger (cons 1 (length filter)))
      (mapcar (function car) filter)
    )
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbvariant (cons 1 (length filter)))
      (mapcar (function cdr) filter)
    )
  )
)

(defun pl:lst-to-lsts (lst modul / _lsttolsts)
  (defun _lsttolsts (slst i mod / tmp)
    (cond ((not slst) nil)
          ((zerop i) (cons (list (car slst)) (_lsttolsts (cdr slst) mod mod)))
          (t
           (setq tmp (_lsttolsts (cdr slst) (1- i) mod))
           (cons (cons (car slst) (car tmp)) (cdr tmp))
          )
    )
  )
  (_lsttolsts lst (1- modul) (1- modul))
)

(defun c:demo () (pl:put-point-to-mesh) (princ))
Доработка "напильником" - по отзывам.
Alaspher вне форума  
 
Непрочитано 28.03.2005, 13:06
#3
Эдуард

строительство
 
Регистрация: 16.01.2004
Петербург
Сообщений: 165
<phrase 1=


Код:
[Выделить все]
(defun mesh-dot	(/ pt-list mesh coordmesh)
  (if
    (and
      (setq mesh (car (entsel "Select 3dMesh:")))
      (= (vla-get-objectname
	   (setq mesh (vlax-ename->vla-object mesh))
	 ) ;_  end of_vla-get-objectname
	 "AcDbPolygonMesh"
      ) ;_  end of_=
    ) ;_  end of_and
     (progn
       (setq coordmesh (vlax-safearray->list
			 (vlax-variant-value
			   (vla-get-coordinates mesh)
			 ) ;_  end of_vlax-variant-value
		       ) ;_  end of_vlax-safearray->list
       ) ;_  end of_setq
       (foreach	i coordmesh
	 (if (/= (length pt-list) 3)
	   (setq pt-list (cons i pt-list))
	   (progn
	     (addpoint)
	     (setq pt-list nil pt-list (cons i pt-list))
	   ) ;_  end of_progn
	 ) ;_  end of_if
       ) ;_  end of_foreach
       (addpoint)
     ) ;_  end of_progn
  ) ;_  end of_if
  (princ)
) ;_  end of_defun
(defun addpoint	()
  (vla-addpoint
    (vla-ObjectIDToObject
      (vla-get-ActiveDocument (vlax-get-acad-object))
      (vla-get-ownerid mesh)
    ) ;_  end of_vla-ObjectIDToObject
    (vlax-3d-point (reverse pt-list))
  ) ;_  end of_vla-addpoint
) ;_  end of_defun
Эдуард вне форума  
 
Автор темы   Непрочитано 28.03.2005, 14:22
#4
Torino


 
Регистрация: 21.08.2003
Штаб
Сообщений: 943
<phrase 1=


>>Alaspher
Напильник не понадобился, все работает!

>>Alaspher, Эдуард
Спасибо за помощь!
Torino вне форума  
 
Непрочитано 22.05.2018, 13:58
#5
Maker


 
Регистрация: 22.05.2018
Сообщений: 4


А можно сделать так, чтобы вместо точек лисп создавал бы 3D Face, точь-в-точь копируя и геометрию, и наследуя цвета Polyface Mesh?
Maker вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Лисп, создающий точки во всех узлах polyface mesh

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

Расширенный поиск