带预览o的拉伸命令
下面的测试代码没有显示光标所在的pt2的新位置。任何人都知道如何让它发挥作用。DRAGMODE varaible设置为ON。
(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)
) 为什么它会显示什么？您只需设置一些坐标，然后命令“立即”运行。因此，在执行拉伸命令时通常会看到的“预览”部分没有显示。
我想知道这个lisp的目的是什么，除了STRETCH命令本身没有做好准备外，它没有做任何额外的事情。
我使用stretch命令的方式是输入“S”表示stretch。然后选择要拉伸的对象，单击起点和终点。无需R（ectangle）动作。 这是我遇到问题的代码的精简版本。我不是想重新发明拉伸命令，我只需要知道。是否可以修改该代码以显示pt2的位置。 (command "stretch" "c" rec1 rec2 "" "_non" pt1 "_non" pause)？
并拆除PT2的SETQ部分
E： 经过测试，似乎有效。”lisp代码中的“暂停”表示手动输入，以防您需要知道它的功能。
不幸的是，我不能在这里使用暂停。它需要保留pt2和setvar pt2。
请参阅此处的完整代码：
(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) <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)
页:
[1]