求助，修改langjs大师的快速对齐视图源码失败，求教请进！

cj52000

      大家好，在网上找到langjs大师的快速移动对齐视图原码，就试着修改下想让它变成拉伸对齐，就把里面的"move" 改为 “stretch",结果不成功，又试着改了几次还是没成功，还请langjs大师及各位兄弟帮心完善下，谢谢！

;;; ==================================
;;; 快速拉伸对齐视图(基准线为直线或多段线)
;;; 作者：langjs 　           命令：sy
;;; ==================================
(defun c:sy (/ bk en ent ent1 name pmax pmin pt pt0 pt1 pt2 sc snap ss ss1 vh vw)
  (setq ss (ssget)
pt (getpoint "\n指定基点:")
en (entsel "\n选择基准线:")
pt0 (cadr en)
name (car en)
ent (entget name)
  )
  (setq snap (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (cond
    ((= (cdr (assoc 0 ent)) "LINE")
      (setq pt1 (cdr (assoc 10 ent))
     pt2 (cdr (assoc 11 ent))
      )
    )
    ((= (cdr (assoc 0 ent)) "LWPOLYLINE")
      (setq vh (getvar "viewsize")
     sc (getvar "screensize")
     bk (getvar "APERTURE")
     vw (* vh (/ bk (cadr sc)))
     pmin (list (- (car pt0) (* 0.5 vw)) (- (cadr pt0) (* 0.5 vw)))
     pmax (list (+ (car pt0) (* 0.5 vw)) (+ (cadr pt0) (* 0.5 vw)))
      )
      (command ".explode" name)
      (setq ss1 (ssget "c" pmin pmax)
     ent1 (entget (ssname ss1 0))
     pt1 (cdr (assoc 10 ent1))
     pt2 (cdr (assoc 11 ent1))
      )
      (command ".UNDO" "")
    )
  )
  (command ".xline" pt1 pt2 "")
  (setq ent (entlast))
  (redraw ent 3)
  (setvar "osmode" snap)
  (command ".STRETCH" ss "" pt pause)
  (entdel ent)
  (princ)
)

langjs

看看是不是想要的
;;; ==================================
;;; 快速拉伸对齐视图(基准线为直线或多段线)
;;; 作者：langjs 　           命令：sy
;;; ==================================
(defun c:sy (/ en ent i n name obj p p1 p2 pp pt pt1 pt2 ss)
  (vl-load-com)
  (setvar "cmdecho" 0)
  (if (setq p1 (getpoint "\n指定第一点:"))
    (if (setq p2 (getcorner p1 "\n窗交对象:指定对角点:"))
      (if (setq ss (ssget "c" p1 p2))
        (progn
          (repeat (setq i (sslength ss))
            (redraw (ssname ss (setq i (1- i))) 3)
          )
          (if (setq pt (getpoint "\n指定基点:"))
            (if (setq en (entsel "\n选择基准线:"))
              (progn
                (setq name (car en)
                      p (cadr en)
                      ent (entget name)
                )
                (cond
                  ((= (cdr (assoc 0 ent)) "LINE")
                    (setq pt1 (cdr (assoc 10 ent))
                          pt2 (cdr (assoc 11 ent))
                    )
                  )
                  ((= (cdr (assoc 0 ent)) "LWPOLYLINE")
                    (setq obj (vlax-ename->vla-object name)
                          pp (vlax-curve-getclosestpointto obj (trans p 1 0))
                          n (fix (vlax-curve-getparamatpoint obj pp))
                          pt1 (vlax-curve-getpointatparam obj n)
                          pt2 (vlax-curve-getpointatparam obj (1+ n))
                    )
                  )
                )
                (command ".xline" pt1 pt2 "")
                (setq ent (entlast))
                (redraw ent 3)
                (command "_.stretch" "c" p1 p2 "" pt pause)
                (entdel ent)
              )
            )
            (if ss
              (repeat (setq i (sslength ss))
                (redraw (ssname ss (setq i (1- i))) 4)
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

panliang9

想法不错！

cj52000

langjs 发表于 2018-10-27 18:11
看看是不是想要的
;;; ==================================
;;; 快速拉伸对齐视图(基准线为直线或多段线) ...

太感谢langjs大师了

czb203

langjs大师好久没出山了

20060510412

不知道咋用的哦

依然小小鸟

怎么用呢 能录制一个gif吗