设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 106|回复: 7

[工具] 网上收集的缩放工具,希望增加直接按空格表示不缩放功能

[复制链接]
发表于 2019-11-18 10:21:05 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
(defun C:sz (/ bp ss xscal yscal entL)
  (setvar "qaflags" 0)
  (defun errexit (s)
    (princ "\nError:  ")
    (princ s)
    (restore)
  )
  (defun restore ()
    (setvar "CMDECHO" (car oldvar))
    (setq *error* olderr)
    (princ)
  )
  (defun MAKEUNBLOCK (ss ip / tmp errexit mbx BLAYER)
    (setq olderr  *error*
          *error* errexit
    )
    (setq oldvar (list (getvar "CMDECHO")))
    (setvar "CMDECHO" 0)
    (terpri)
    (if        BLAYER
      (command "._LAYER"
               (if (tblsearch "LAYER" BLAYER)
                 "_S"
                 "_M"
               )
               BLAYER
               ""
      )
    )
    (if        (and
          ip
          ss
        )
      (progn
        (entmake (list (cons '0 "BLOCK")
                       (cons '2 "*U")
                       (cons '70 1)
                       (cons '10 ip)
                 )
        )
        (setq cnt (sslength ss))
        (while (>= (setq cnt (1- cnt))
                   0
               )
          (setq tmp (ssname ss cnt))
          (entmake (setq el (entget tmp)))
          (if (> (cdr (assoc 66 el)) 0)
            (while (/= "SEQEND"
                       (cdr (assoc 0
                                   (entmake (setq el
                                                   (entget
                                                     (entnext
                                                       (cdr
                                                         (assoc -1 el)
                                                       )
                                                     )
                                                   )
                                            )
                                   )
                            )
                       )
                   )
            )
          )
          (entdel tmp)
        )
        (setq tmp (entmake (list (cons '0 "ENDBLK"))))
        (entmake
          (list (cons '0 "INSERT") (cons '2 tmp) (cons '10 ip))
        )
      )
    )
    (restore)
  )
  (setq ss (cadr (ssgetfirst)))
  (while (= ss nil)
    (setq ss (ssget))                        ; 选择缩放实体
  )
  (setq        i 0
        dwcorn nil
        upcorn nil
  )
  (repeat (sslength ss)
    (setq ent (ssname ss i))
    (setq obj (vlax-ename->vla-object ent))
    (vla-GetBoundingBox obj 'pta 'ptb)
    (setq dwcorn (cons (vlax-safearray->list pta) dwcorn))
    (setq upcorn (cons (vlax-safearray->list ptb) upcorn))
    (setq i (1+ i))
  )
  (setq        ptlist (append
                 dwcorn
                 upcorn
               )
  )
  (setq        x (mapcar
            'car
            ptlist
          )
  )
  (setq        y (mapcar
            'cadr
            ptlist
          )
  )
  (setq        x1 (apply
             'min
             x
           )
  )
  (setq        y1 (apply
             'min
             y
           )
  )
  (setq        x2 (apply
             'max
             x
           )
  )
  (setq        y2 (apply
             'max
             y
           )
  )
  (setq xx (- (car (list x2 y2)) (car (list x1 y1))))
  (setq yy (- (cadr (list x2 y2)) (cadr (list x1 y1))))
  (if ss
    (progn
      (setq bp (polar (list x1 y1)
                      (angle (list x1 y1) (list x2 y2))
                      (/ (distance (list x1 y1) (list x2 y2)) 2)
               )
      )
      (setq xx1 (getdist "\n指定新的X方向尺寸:"))
      (setq yy1 (getdist "\n指定新的Y方向尺寸:"))
      (setq xscal (/ xx1 xx))
      (setq yscal (/ yy1 yy))
      (MAKEUNBLOCK ss bp)
      (setq entL (entget (entLast))
            entL (subst
                   (cons 41 xscal)
                   (assoc 41 entL)
                   entL
                 )
            entL (subst
                   (cons 42 yscal)
                   (assoc 42 entL)
                   entL
                 )
      )
      (entmod entL)
      (command "_explode" "l")
    )
  )
  (princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 2275个

财富等级: 金玉满堂

发表于 2019-11-19 00:01:07 | 显示全部楼层
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 5491个

财富等级: 富甲天下

发表于 2019-11-19 08:05:32 | 显示全部楼层
本帖最后由 HLCAD 于 2019-11-20 09:55 编辑

(setq xscal (/ xx1 xx))
(setq yscal (/ yy1 yy))
;;; 分别改为:
(if (and xx1 (numberp xx1))
  (setq xscal (/ xx1 xx))
  (setq xscal 1.0)
  )
(if (and yy1 (numberp yy1))
  (setq yscal (/ yy1 yy))
  (setq yscal 1.0)
  )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2019-11-19 23:24:12 | 显示全部楼层
HLCAD 发表于 2019-11-19 08:05
(setq xscal (/ xx1 xx))
(setq yscal (/ yy1 yy))
;;; 分别改为:

很谢谢你的帮助!不知道为什么,经过测试发现,如果先设置了X方向值,Y方向按空格,可以达到预期效果,但是,如果先按了空格,再输入Y方向的值,则没有变化。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 9个

财富等级: 恭喜发财

发表于 2019-11-20 02:46:42 | 显示全部楼层
谢谢分享好插件!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 5491个

财富等级: 富甲天下

发表于 2019-11-20 09:57:17 | 显示全部楼层
我重新修改了一下,你再试试
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2019-11-20 15:51:25 | 显示全部楼层
HLCAD 发表于 2019-11-20 09:57
我重新修改了一下,你再试试

非常漂亮!感谢!另外我问个题外话,为什么矩形的多义线经过缩放后,会被打碎成多个直线?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 前天 16:05 | 显示全部楼层
楼主,怎么使用?试试用下。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2019-12-13 01:12 , Processed in 0.154982 second(s), 36 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表