[编程交流] 带预览o的拉伸命令

(defun c:test (/ rec1 rec2)
 (setq rec1 (getpoint "select first "))
 (setq rec2 (getcorner rec1 "select second"))
 (setq pt1 (getpoint "\nSelect Base Point : "))
 (setq pt2 (getpoint pt1 "\nSelect Second Point : "))
 (command "stretch" "c" rec1 rec2 "" "_non" pt1 "_non" pt2)
 )

(command "stretch" "c" rec1 rec2 "" "_non" pt1 "_non" pause)

(defun c:BS ( /
*error*
ans
doc
grid
joint
pt1
pt2
ss
vars
)
(defun *error* (msg)
(if vars (SetVars vars))
(vla-endundomark doc)
(if (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*"))
        (princ (strcat "\n<< Error : " msg " >>"))
        )
(princ)
)
(setq doc (vla-get-activedocument (setq cad (vlax-get-acad-object))))
(vla-endundomark doc)
(vla-startundomark doc)
(if
(and
        (setq ss (ssget))
        (progn
                (SF:redraw_sset ss :vlax-true)
                (initget "Minus Stand Plus Custom None")
                (setq ans (getkword "\nCO Size ? (Stand Brick=112.5mm / Joint=10mm)[Minus ( co - )/Stand ( co )/Plus ( co + )/Custom interval/None] <Stand>: "))
                (cond
                        ((or (not ans) (= "Stand" ans))
                                (setq grid 112.5)
                                (setq joint 0.0)
                                )
                        ((= "Minus" ans)
                                (setq grid 112.5)
                                (setq joint -10.0)
                                )
                        ((= "Plus" ans)
                                (setq grid 112.5)
                                (setq joint 10.0)
                                )
                        ((= "Custom" ans)
                                (setq grid (getreal "\nCustom interval size : "))
                                (setq joint 0.0)
                                )
                        )
                T
                )
        (setq pt1 (getpoint "\nSelect Base Point : "))
        (setq vars
                (SetVars
                        (if (= "None" ans)
                                '((cmdecho 0))
                                (list
                                        '(cmdecho 0)
                                        (list 'snapbase (list (car pt1) (cadr pt1)))
                                        '(griddisplay 0)
                                        '(gridmode 1)
                                        '(snapmode 1)
                                        '(dragmode 2)
                                        '(osmode 0)
                                        '(orthomode 1)
                                        (list 'gridunit (list grid grid))
                                        (list 'snapunit (list grid grid))
                                        )
                                )
                        )
                )
        (setq pt2 (getpoint pt1 "\nSelect Second Point : "))
        )
(progn
        (if grid
                (setq pt2 (ModularizePoint pt2 pt1 grid joint))
                )
                 ; (command "_.stretch" ss "" "_non" pt1 "_non" (list (car pt2) (cadr pt2)))
                 (command "stretch" ss "" "_non" pt1 "_non" pt2)
                 (SF:redraw_sset ss :vlax-false)
                 (princ
                         (strcat
                                 "\nModular dimension : " (if grid "ON " "OFF ")
                                 "\nStretched : " (rtos (distance pt1 pt2)) " "
                                 )
                         )
                 )
)
(if vars (SetVars vars))
(vla-endundomark doc)
(princ)
)
;; by 3dwannab
;; Usage:
;; (SF:redraw_sset ss :vlax-true)
;; (SF:redraw_sset ss :vlax-false)
(defun SF:redraw_sset (ent boolean / ent)
(repeat (setq in (sslength ent))
        (vla-highlight (vlax-ename->vla-object (ssname ent (setq in (1- in)))) boolean)
        )
)
;; Round half towards pos. or neg. infinity.
(defun Round (num)
(fix ((if (minusp num) - +) num 0.5))
)
;; Recalculate pt so that the X, Y and Z distance to base are n times module plus joint.
;; Written by Roy_043 - http://www.cadtutor.net/forum/showthread.php?99652-Stretch-in-X-axis-with-choosen-value-in-those-increments&p=678315&viewfull=1#post678315
(defun ModularizePoint (pt base module joint)
(mapcar
        '(lambda (coordPt coordBase / delta)
                (setq delta (* module (Round (/ (- coordPt coordBase) (float module)))))
                (cond
                        ((zerop delta)  coordBase)
                        ((minusp delta) (+ coordBase delta (- joint)))
                        (T              (+ coordBase delta joint))
                        )
                )
        pt
        base
        )
)
;; setvars
(defun SetVars (lst)
(mapcar
        '(lambda (sub / old)
                (setq old (getvar (car sub)))
                (if (cadr sub) (setvar (car sub) (cadr sub)))
                (list (car sub) old)
                )
        lst
        )
)
(vl-load-com)
(princ)