vl-AutoLispR14 Crop the Entities inside Rectangle and export to Wbloc

lisp2arx
Visual Programming for AutoLisp Mathématiques en programmation Lisp.. doc2cpp,doc2lsp, sld2lsp, bmp2dcl, free__GifCcapture for all-CAD'platforms..

Lista Forumurilor Pe Tematici

lisp2arx | Reguli | Inregistrare | Login

POZE LISP2ARX

Nu sunteti logat.

Nou pe simpatie:
Alexandraa. din Braila

Femeie
22 ani
Braila
cauta Barbat
26 - 80 ani

lisp2arx / Listof AutoLisp.100 / vl-AutoLispR14= Crop the Entities inside Rectangle and export to Wbloc

Moderat de zauchan

Autor

Mesaj

Pagini: 1

zauchan
Moderator

Inregistrat: acum 13 ani
Postari: 180

(defun TAIERE()
(prompt "\nTAIERE lucreaza ... Asteptati "
(setq SS2 (ssget "C" P1 P3) SLN (sslength SS2) CNT 0)
(repeat SLN
(setq NOM (ssname SS2 CNT)
GT (entget NOM)
GTA (cdr (assoc 0 GT))
PS (cdr (assoc 10 GT))
PE (cdr (assoc 11 GT))
)
(if (= GTA "LINE"
(progn
(setq BP (inters P1 P2 PS PE))
(if (boundp 'BP) (command "BREAK" NOM BP "@")
(setq BP (inters P2 P3 PS PE))
(if (boundp 'BP) (command "BREAK" NOM BP "@")
(setq BP (inters P3 P4 PS PE))
(if (boundp 'BP) (command "BREAK" NOM BP "@")
(setq BP (inters P4 P1 PS PE))
(if (boundp 'BP) (command "BREAK" NOM BP "@")
)
)
(setq CNT (+ 1 CNT))
)
)

(defun EXPLODAT ()
(prompt"\n EXPLODAT lucreaza... Asteptati "
(setq SS3 (ssget "C" P1 P3)
SLN (sslength SS3)
CNT 0
)
(repeat SLN
(setq NOM (ssname SS3 CNT)
GT (entget NOM)
GTA (cdr (assoc 0 GT))
)
(if (= GTA "POLYLINE"
(command "EXPLODE" NOM)
)
(setq CNT (+ 1 CNT))
)
)

(defun C:CAPTURA ()
(setvar "CMDECHO" 0)
(graphscr)
(setq strat (tblsearch "LAYER" "EXTRAS")
(if (/= strat nil) (command "layer" "OFF" "EXTRAS" ""
(command "layer" "N" "EXTRAS" "OFF" "EXTRAS" ""
)
(prompt "\nNB: Aveti"
(setq P1 (getpoint "\nPrimul colt:"
P3 (getcorner P1 "\nColtul opus:"
P2 (list (car P3) (cadr P1))
P4 (list (car P1) (cadr P3))
xmin (min (car P1) (car P2) (car P3) (car P4))
xmax (max (car P1) (car P2) (car P3) (car P4))
ymin (min (cadr P1) (cadr P2) (cadr P3) (cadr P4))
ymax (max (cadr P1) (cadr P2) (cadr P3) (cadr P4))
P5 (list xmin ymin)
P6 (list xmax ymax)
P7 (polar P5 (/ pi 4) 0.5)
P8 (polar P6 (* (/ pi 4) 5) 0.5)
)
(command "line" "non" P1 "non" P2 "non" P3 "non" P4 "C"
(prompt "\nCAPTURA lucreaza... Asteptati"
(command "LAYER" "S" "0" "OFF" "EXTRAS" ""
(explodat)
(taiere)
(taiere)
(command "CHPROP" "C" "non" P7 "non" P8 "" "LA" "EXTRAS" ""
(command "line" "non" P1 "non" P2 "non" P3 "non" P4 "C"
(setvar "CMDECHO" 1)
(princ)
)

(defun C:EXPORT ()
(setvar "CMDECHO" 0)
(prompt "\nNumele desenului de creat (fara extensie)"
(setq NOM2 (getstring)
NOM3 (strcat NOM2 ".DWG"
DESVERF (findfile NOM3))
(if (= nil DESVERF)
(progn
(prompt "\nEXPORT-ul lucreaza... Asteptati"
(command "LAYER" "ON" "EXTRAS" ""
(setq SS3 (ssget "X" (list (cons 8 "EXTRAS")))
(command "BLOCK" NOM2 P4 SS3 ""
(command "WBLOCK" NOM2 NOM2)
(prompt "\n Totul este salvat in fisierul:"(princ NOM3)
)
(prompt "\nDesenul exista deja! Apasati <Enter> pentru o noua incercare"
)
(setvar "CMDECHO" 1)
(princ)
)

_______________________________________
psw: cea de la wjndowsXP gigabyte..

pus acum 4 ani

Pagini: 1

Mergi la