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: bruneta_mara
 | Femeie 19 ani Ialomita cauta Barbat 26 - 52 ani |
|
admin
Administrator
Din: Bucharest
Inregistrat: acum 14 ani
Postari: 517
|
|
Code:
(defun pp_enblock_bsps(/ os ce bm blk ent obj ppt dst ept ref len ipt par slp ang loopw nop mov rol ror) (command "_.undo" "_be") (setq os (getvar "osmode") ce (getvar "cmdecho") bm (getvar "blipmode") blk "") (setvar "osmode" 0) (setvar "cmdecho" 0) (setvar "blipmode" 0) (progn (setq
ent nil) (while (= ent nil) (setq ent (entsel "\nSelect polyline near reference end:")))) (progn (setq
loopW 1) (while (< loopW 100) (setq mov (entsel "\nSelect BlockN:") rol (if (/= mov nil) (assoc 2 (entget (car mov))) nil)
ror (if rol (cdr rol) nil) blk (if (and (= (type ror) (quote STR)) (> ror "")) ror (getstring T "\nBlock name:(enter.loopw) ")) loopw (if (and (> blk "") (tblsearch "block" blk)) 100 32)))) (progn (setq
loopW 1) (while (> loopw 0) (progn (setq obj (car ent)
ppt (if obj (osnap (cadr ent) "NEA") nil)
dst (if ppt (getdist "\nDistance to Block Insertion:") nil)
ept (if dst (vlax-curve-getendpoint obj) nil)
ref (if ept (vlax-curve-getdistatpoint obj ppt) nil)
len (if ref (vlax-curve-getdistatpoint obj ept) (- 3))
dst (if (and (> len 0) (> ref (/ len 2.0))) (- len dst) dst)
ipt (if (> len 0) (vlax-curve-getpointatdist obj dst) nil)
par (if (> len 0) (vlax-curve-getparamatpoint obj ipt) nil)
slp (if par (vlax-curve-getfirstderiv obj par) nil)
ang (if par (atan (/ (cadr slp) (car slp))) nil)) (if ang (entmake (list (cons 0 "INSERT") (cons 2 blk) (cons 10 ipt) (cons 50 ang)))) (terpri) (setq
loopw (if (and obj dst ept ipt) 3 (- 5010)))))) $rr) |
36.7KB
_______________________________________
|
|
pus acum 4 ani |
|