lisp2arx
Visual Programming for AutoLisp
Mathématiques en programmation Lisp..
doc2cpp,doc2lsp, sld2lsp, bmp2dcl,
free__GifCcapture for all-CAD'platforms..
|
Nou pe simpatie:
LaraTaner pe Simpatie.ro
 | Femeie
24 ani
Prahova
cauta Barbat
24 - 52 ani |
|
|
lisp2arxReguliInregistrareLoginPozeNu sunteti logat. Lista Forumurilor Pe Tematici
|
| #1 |
|
|
(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..
|
|
| |
|
