;|===============================================
Построение проекций 3D тел из пространства модели
Программа Дениса Флюстикова "Solprof_Den" от 18.07.07
Исправил, погонял, вроде все OK.
Макрос для кнопки:
^C^C^P(load "Solprof_Den");Solprof_Den
В файл "Solprof_Den.lsp" вставить текст только до строчки:
; Конец файла "Solprof_Den.lsp"
далее текст для файла "Solprof_Den.dcl"
===============================================|;
(defun C:Solprof_Den (/ layer aa0 aa1 aa2 aa3 aa4 aa5 aa6 osmode *error* dcl_id)
(setq layer "Основной" ;Слой построения проекции
osmode (getvar "OSMODE")
aa0 (getvar "VIEWCTR")
aa1 (cadr (grread 1 1))
aa2 (angle aa0 aa1)
aa3 (distance aa0 aa1)
aa0 (getvar "SCREENSIZE")
aa1 (/ (cadr aa0)(getvar "VIEWSIZE"))
aa0 (mapcar '/ aa0 '(2 2))
aa1 (polar aa0 (- aa2) (* aa3 aa1))
aa1 (mapcar '(lambda (q) (fix q)) aa1)
aa0 nil
dcl_id (load_dialog "Solprof_Den")
aa4 nil)
;Для расположения диалог.окна у курсора при вызове программы, удалить строчку:
(setq aa1 '(-1 -1))
(if (not (new_dialog "Solprof_Den" dcl_id "" aa1))(exit))
(mode_tile "aa1" 0)
(set_tile "aa1" "0")
(action_tile "aa1" "(setq aa1 (read $value))(done_dialog)")
(action_tile "cancel" "(setq aa1 nil)(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
(if aa1 (progn
(if (and (> aa1 0)(< aa1 5))(progn
(princ "\nВыбор 3М тел или <проекция разреза>")
(if (null (setq aa0 (ssget '((0 . "3DSOLID")))))(progn
(setq aa3 (getpoint "\nУкажите точку на разрезе:")
aa0 (ssget '((0 . "3DSOLID"))))
(cond
((= aa1 1)(setq aa3 (list (car aa3)(cadr (getvar "EXTMIN")))
aa2 (getvar "EXTMAX")))
((= aa1 2)(setq aa3 (list (car aa3)(cadr (getvar "EXTMAX")))
aa2 (getvar "EXTMIN")))
((= aa1 3)(setq aa3 (list (car (getvar "EXTMAX"))(cadr aa3))
aa2 (getvar "EXTMIN")))
((= aa1 4)(setq aa3 (list (car (getvar "EXTMIN"))(cadr aa3))
aa2 (getvar "EXTMAX")))
)
(setq aa3 (trans aa3 0 1)
aa2 (trans aa2 0 1)
aa4 (ssget "_C" aa3 aa2 '((0 . "3DSOLID")))
aa5 (sslength aa0))
)))
(setq aa0 (ssget '((0 . "3DSOLID"))))
)
))
(if (= (getvar "TILEMODE") 1)
(if aa0 (progn
(vl-load-com)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setvar "CMDECHO" 0)
(defun *error* (msg)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(if (>= (atof (getvar "ACADVER")) 16.2)
(vla-sendcommand (vla-get-activedocument
(vlax-get-acad-object)) "_.undo 1 ")
(command nil nil nil nil "_.undo" 1))
(princ "\nВыход во время обработки данных\n")
)
(princ "\nПодождите, выполняется обработка данных...\n")
(setvar "tilemode" 0)
(command "_.undo" "_m"
"_.-vports" ""
"_.mspace")
(if aa4 (progn
(repeat aa5
(setq aa5 (1- aa5)
aa6 (ssname aa0 aa5))
(if (ssmemb aa6 aa4)
(command "_.layer" "_u" (cdr (assoc 8 (entget aa6))) "")
(setq aa0 (ssdel aa6 aa0)))
)
(if (> aa1 2)(setq aa4 "@1,0,0")(setq aa4 "@0,1,0"))
(setq aa3 (trans aa3 1 0)
aa2 (trans aa2 1 0))
(command "_.slice" aa0 "" "_none" aa3 "_none" aa4 "_none" "@0,0,1" aa2)
))
(setq aa5 (sslength aa0)
aa4 0
aa6 '(0 0 0))
(repeat aa5
(vla-GetBoundingBox (vlax-ename->vla-object (ssname aa0 aa4)) 'aa2 'aa3)
(setq aa2 (vlax-safearray->list aa2)
aa3 (vlax-safearray->list aa3)
aa2 (mapcar '+ aa2 aa3)
aa2 (mapcar '/ aa2 '(2 2 2))
aa6 (mapcar '+ aa2 aa6)
aa4 (1+ aa4))
)
(setq aa6 (mapcar '/ aa6 (list aa5 aa5 aa5))
aa6 (trans aa6 0 1))
(arxload "AcSolids.arx")
(if (zerop aa1)
(setq aa4 90)
(if (= aa1 5)
(setq aa4 270)
(setq aa4 0)))
(command "_.vpoint" "_r" (nth aa1 '(0 180 0 90 270 0)) aa4)
(princ "\nПодождите, выполняется обработка данных...\n")
(c:solprof aa0 "" "" "")
(setq aa0 (entlast)
aa2 (cdr (assoc 8 (entget aa0)))
aa3 (cdr (assoc 2 (entget aa0))))
(vla-delete (vlax-ename->vla-object aa0))
(vla-Delete (vla-Item (vla-get-Blocks (vla-get-activedocument
(vlax-get-acad-object))) aa3))
(setq aa0 (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))))
(if (eq (type (vl-catch-all-apply 'vla-Item (list aa0 aa2))) 'VLA-OBJECT)
(vl-catch-all-apply 'vla-Delete (list (vla-Item aa0 aa2))))
(setq aa0 (entlast)
aa3 (cdr (assoc 8 (entget aa0)))
aa2 (vlax-ename->vla-object aa0))
(if (not (tblsearch "Layer" layer)); Если нет заданного слоя, то построение в текущем
(setq layer (getvar "CLAYER")))
(if (= (cdr (assoc 70 (tblsearch "Layer" layer))) 4)
(princ (strcat "\nСлой " layer " заблокирован\n"))(progn
(vlax-for x (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-name aa2))
(vla-put-layer x layer)
(vla-put-lineweight x -1)
)
(vlax-put-property aa2 'layer layer)
(vlax-put-property aa2 'lineweight -1)
(setq aa2 (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))))
(if (eq (type (vl-catch-all-apply 'vla-Item (list aa2 aa3))) 'VLA-OBJECT)
(vl-catch-all-apply 'vla-Delete (list (vla-Item aa2 aa3))))
))
(setvar "OSMODE" 0)
(if (> aa1 0)
(command "_.rotate3d" aa0 "" aa6
(nth aa1 (list 0 "@0,1,0" "@0,-1,0" "@1,0,0" "@-1,0,0" "@1,0,0"))(if (= aa1 5) 180 90)
))
(setq aa2 (car aa6)
aa4 (cadr aa6)
aa3 (caddr aa6)
aa6 (nth aa1 (list 0 (+ aa3 aa2)(- aa3 aa2)(- aa3 aa4)(+ aa3 aa4)(* 2 aa3)))
aa2 (getvar "tempprefix")
aa3 "Solprof_Den")
(while aa1
(if (or (tblsearch "block" aa3)
(findfile (strcat aa2 aa3 ".dwg")))
(setq aa3 (strcat aa3 "1"))
(setq aa1 nil))
)
(command "_.-wblock" (strcat aa2 aa3) "" (list 0 0 aa6) aa0 ""
"_.undo" "_b")
(setvar "tilemode" 1)
(command "_.-insert" (strcat aa2 aa3) "_none" '(0 0 0))
(while (= (getvar 'cmdactive) 1)(command ""))
(command "_.explode" (entlast))
(vl-file-delete (strcat aa2 aa3 ".dwg"))
(vla-delete (vla-Item (vla-get-Blocks (vla-get-activedocument
(vlax-get-acad-object))) aa3))
(setq aa0 (entlast)
aa1 (cadr (grread 1 1))
aa3 1); Проекция: 0 - Блоком, 1 - Примитивами
(while aa1
(vl-cmdf "_.move" aa0 "" aa1)
(setvar "OSMODE" osmode)
(princ (strcat "\nУкажите положение проекции или <" (nth aa3 '("Примитивами>:" "Блоком>:"))))
(setq aa2 (vl-cmdf pause))
(if (and aa2 (equal aa1 (getvar "lastpoint") 0.000001))(progn
(setq aa2 (getvar 'lastprompt)
aa2 (substr aa2 (+ (vl-string-search ">:" aa2) 3)))
(if (= aa2 "0")
(setq aa1 nil)(progn
(command "_.undo" 1)
(setvar "OSMODE" 0)
(setq aa3 (abs (1- aa3)))
)))
(setq aa1 nil)
)
)
(if aa2
(if (= aa3 1)(progn
(setq aa3 (cdr (assoc 2 (entget aa0))))
(command "_.explode" aa0)
(command "_-purge" "_b" aa3 "_n");Пока так, т.к. через vla-delete у меня решения нет
))
(command "_.erase" aa0 "")
)
(setvar "CMDECHO" 1)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
))
(princ "\nНеобходимо перейти в модель")
)
(princ)
)
; Конец файла "Solprof_Den.lsp"// Начало файла Solprof_Den.dcl
Solprof_Den:dialog {
label = "3М вид";
fixed_width = true;
:list_box {
key = "aa1";
list =" Главный вид\n Слева\n Справа\n Сверху\n Снизу\n Сзади";
height = 7;
}
: cancel_button {
label="Отмена";
width = 12;
}
}
