custom scale-lisp (opgelost)

[Manu]

Vóór ik het net ernaar afschuim vraag ik het eerst hier :

Kent iemand een custom-scale-lisp die toelaat om verschillende verschalingswaardes toe te kennen voor de X- en de Y waarde van een tekenobject? Standaard gebruikt AutoCad 1 gelijke waarde voor beide.. en dat kan beter..
Toegegeven, ik zou het object eerst als block kunnen wegschrijven om die dan weer te inserten ( want dan kan ik de waarden wél afzonderlijk ingeven) maar dat is me echt te omslachtig...

iemand?

groeten,

Manu

UPDATE : blijkbaar was deze niet zo makkelijk om vinden, maar na wat googelen bracht XSCALE.LSP de oplossing.
Je stelt er de X-,Y- én Z verschaling van een tekenobject zelf in... werkt prima!

[Manu]

ach, en wie weet heeft iemand anders dit ooit ook nog van doen... dus hieronder de code :

;;;    XSCALE.LSP / 04JUL95 / 03MAY96
;;;     
;;;    Copyright (C) 1995, 1996 by Thomas Berger
;;;
;;;    FREEWARE:
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    THOMAS BERGER PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    THOMAS BERGER SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  THOMAS BERGER
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;
;;;    ****************************************************************
;;;    XSCALE: xyz scaling of selected entities
;;;
;;;    AutoCAD version: R13 only, ACIS solids need R13 C2 or higher
;;;
;;;    functions:
;;;       C:XSCALE     for use at the command prompt
;;;       (XSCALE sset basepoint xscale yscale zscale)  for API usage
;;;       (MAKEBLOCK name basepoint sset xscale yscale zscale rotation)
;;;          to entmake blocks (anonymous block if name="*")
;;;       C:MAKEBLOCK     for use at the command prompt
;;;
;;;    known bugs:
;;;       there is an AutoCAD bug still existent in R13c4 that
;;;       does not allow to explode blocks correctly with equal scaling
;;;       in X- and Y-direction and a different factor in Z-direction. In this
;;;       special case the exploded block will fall back to the 1-1-1
;;;       scaling.
;;;      Workaround:
;;;       Use slightly different scaling factors for the X- and the
;;;       Y-direction (i.e 1.00001 and 0.999999)


(defun xscale (sset basp xscale yscale zscale / )
(if (makeblock "*" basp sset xscale yscale zscale 0)
        (command "._explode" (entlast))
)
)


(defun c:xscale (/ oldecho olderr temp xs ys zs basp sset)
        (setq oldecho (getvar "cmdecho") olderr *error*)
        (command "._undo" "_group")
        (defun *error* (msg)
                (setq *error* olderr)
                (princ (strcat "\nXSCALE: " msg "\n"))
                (prin1)
        )
        (setvar "cmdecho" 0)
        (setq basp (while (not temp) (setq temp (getpoint "\nbase point: ")))
                        sset (if (< 0 (sslength (setq temp (ssget)))) temp nil)
                        xs (if sset (if (not (setq temp (getdist basp "\nX-scale <1>: "))) 1 temp))
                        ys (if sset (if (not (setq temp (getdist basp "\nY-scale <1>: "))) 1 temp))
                        zs (if sset (if (not (setq temp (getdist basp "\nZ-scale <1>: "))) 1 temp))
        )
        (if (and basp sset xs ys zs)
                (xscale sset basp xs ys zs)
        )
        (command "._undo" "_end")
        (setq *error* olderr)
        (setvar "cmdecho" oldecho)
        (prin1)
)


(defun makeblock (name baspoint sset xs ys zs rot / i e en blocktype)
(if sset nil (setq sset (ssadd)))
(if (or (/= 'STR (type name)) (= "" name)) (setq name "*A"))
(if (= (substr name 1 1) "*")
        (setq blocktype 1 name "*A")
        (setq blocktype 0)
)
(entmake (append
        '((0 . "BLOCK"))
        (list (cons 2  name))
        (list (cons 70 blocktype))
        (list (cons 10 baspoint))
))
(setq i -1)
(while (setq e (ssname sset (setq i (1+ i))))
        (cond
                ((/= 1 (cdr (assoc 66 (entget e))))
                        (if (entget e) (progn
                                (entmake (entget e '("*")))
                                (entdel e)
                        ))
                )
                ((= 1 (cdr (assoc 66 (entget e))))
                        (if (entget e) (progn
                                (entmake (entget e '("*")))
                                (setq en e)
                                (while (/= "SEQEND" (cdr (assoc 0 (entget en))))
                                        (setq en (entnext en))
                                        (entmake (entget en '("*")))
                                )
                                (entdel e)
                        ))
                )
        )
)
(setq name (entmake '((0 . "ENDBLK"))))
(if name (progn
        (entmake (append
                '((0 . "INSERT"))
                (list (cons 2 name))
                (list (cons 10 baspoint))
                (list (cons 41 xs))
                (list (cons 42 ys))
                (list (cons 43 zs))
                (list (cons 50 (/ (* PI rot) 180.0)))
        ))


))
(if name (entlast) nil)
)


(defun c:makeblock ()
(makeblock (getstring "\nName: ") (getpoint "\nInsertionpoint: ") (ssget) 1 1 1
0 )
)


(princ "\nXSCALE: scales AutoCAD Entities non-uniformly in X-,Y- and
Z-direction!")
(prin1)