he encontrado esta rutina lisp para dibujar los tauldes, pero tengo un problemilla con ella.
En casa tengo el AutoCAD en ingles i me funciona sin ningun problema, pero en el trabajo tengo el AutoCAD en castellano i por lo tanto no me funciona, he provado de canviar las ordenes peró seguramente me dejo alguna o algo i no me funciona, a ver si alguien es capaz de ayudarme, DEVOLVERMELA CORREGIDA o indicarme que debo hacer.
muchas gracias.
Albert
PRINCIPIO RUTINA:
============================================
;; TAL.LSP
;; Maakt een taludarcering tussen bestaande lijnen.
;;
(defun myerror (e)
(if (/= e "Function cancelled")
(princ (strcat "\nError:" e))
)
(setvar "BLIPMODE" bm)
(setvar "OSMODE" om)
(setvar "EDGEMODE" em)
(setq *error* olderr)
(setvar "CMDECHO" 1)
(princ)
)
(defun C:TAL (/ em om bm boven hafst sset1 sset2 cnt even ent ptx pt1 pt2)
(setq olderr *error* *error* myerror)
(setvar "CMDECHO" 0)
(setq om (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq bm (getvar "BLIPMODE"))
(setvar "BLIPMODE" 0)
(setq em (getvar "EDGEMODE"))
(setvar "EDGEMODE" 0)
(if (null (tblsearch "BLOCK" "TALUD"))
(progn
(entmake '((0 . "BLOCK") (2 . "TALUD") (70 . 64) (10 0.0 0.0 0.0)))
(entmake '((0 . "LINE") (8 . "TALUD") (10 0.0 0.0 0.0) (11 0.0 1.0 0.0)))
(entmake '((0 . "ENDBLK")))
)
)
(setq boven (entsel "\nGeef bovenkant talud. "))
(redraw (car boven) 3)
(princ "\nGeef onderkant talud: ")
(setq onder (ssget))
(if (null afst)
(setq afst (getdist "\nGeef tussenafstand: "))
(setq hafst (getdist (strcat "\nGeef tussenafstand <"
(rtos afst 2 2) ">: ")))
)
(if hafst (setq afst hafst))
(redraw (car boven) 4)
(command "MEASURE" boven "BLOCK" "TALUD" "Y" afst)
(setq sset1 (ssget "X" '((2 . "TALUD"))))
(setq cnt 0)
(setq even T)
(repeat (sslength sset1)
(setq ent (ssname sset1 cnt))
(setq ptx (cdr (assoc 10 (entget ent))))
(command "EXPLODE" ent)
(setq sset2 (ssget "P")
ent (ssname sset2 0)
pt1 (cdr (assoc 10 (entget ent)))
pt2 (cdr (assoc 11 (entget ent)))
an (angle pt1 pt2)
pt1 (list ent (polar pt1 an 0.1))
pt2 (list ent (polar pt2 (+ an pi) 0.1))
)
(command "EXTEND" onder "" pt1 pt2 "")
(command "TRIM" boven "" pt1 "")
(if (< (distance (cdr (assoc 10 (entget ent)))
(cdr (assoc 11 (entget ent)))) 1.2)
(progn
(command "ERASE" ent "")
(setq even nil)
)
)
(if (= even T)
(progn
(command "SCALE" ent "" ptx 0.5)
(setq even nil)
)
(setq even T)
)
(setq cnt (1+ cnt))
)
(setvar "OSMODE" om)
(setvar "BLIPMODE" bm)
(setvar "EDGEMODE" em)
(setq *error* olderr)
(setvar "CMDECHO" 1)
(princ)
)
(princ "\nC:TAL geladen, typ TAL om te activeren. ")
(princ)
======================================
FIN RUTINA
