cj52000 发表于 2018-10-27 14:40:43

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

      大家好，在网上找到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 发表于 2018-10-27 18:11:51

看看是不是想要的
;;; ==================================
;;; 快速拉伸对齐视图(基准线为直线或多段线)
;;; 作者：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 发表于 2018-10-28 12:15:46

想法不错！

cj52000 发表于 2018-10-28 19:37:41

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

太感谢langjs大师了:handshake

czb203 发表于 2018-11-2 09:20:37

langjs大师好久没出山了

20060510412 发表于 2018-11-2 09:43:57

不知道咋用的哦

依然小小鸟 发表于 2018-11-2 12:47:03

怎么用呢 能录制一个gif吗
页: [1]
查看完整版本: 求助，修改langjs大师的快速对齐视图源码失败，求教请进！