套图框(练手作)

kkq0305 · 发表于 2021-8-26 11:31:43

本帖最后由 kkq0305 于 2021-8-26 12:26 编辑

(defun c:tt (/ tk tklst apt bpt ty sc obj)
(vl-load-com)
(prompt "选择图框：")
(setq tk (ssget))
(setq
apt
(car
(mapcar '(lambda (x)
(vla-GetBoundingBox
(vlax-ename->vla-object x)
'minpt
'maxpt
)
(list (vlax-safearray->list minpt)
(vlax-safearray->list maxpt)
)
)
(vl-remove-if-not
'(lambda (x) (= 1 (cdr (assoc 62 (entget x)))))
(setq tklst (vl-remove-if-not
'(lambda (x) (= 'ENAME (type x)))
(apply 'append (ssnamex tk))
)
)
)
)
)
)
(prompt "\n选择需要套图框的图形：")
(while (setq ty (ssget))
(setq
bpt (apply 'append
(mapcar '(lambda (x)
(vla-GetBoundingBox
(vlax-ename->vla-object x)
'minpt
'maxpt
)
(list (mapcar '*
'(1.0 1.0)
(vlax-safearray->list minpt)
)
(mapcar '*
'(1.0 1.0)
(vlax-safearray->list maxpt)
)
)
)
(vl-remove-if-not
'(lambda (x) (= 'ENAME (type x)))
(apply 'append (ssnamex ty))
)
)
)
)
(setq bpt (list (mapcar '- (apply 'mapcar (cons 'min bpt)) '(5 5))
(mapcar '+ (apply 'mapcar (cons 'max bpt)) '(5 5))
)
)
(setq sc (apply 'max
(mapcar '/
(apply 'mapcar (cons '- (reverse bpt)))
(apply 'mapcar (cons '- (reverse apt)))
)
)
)
(foreach n tklst
(setq obj (vla-copy (vlax-ename->vla-object n)))
(vla-move obj
(vlax-3D-point
(mapcar '* '(0.5 0.5) (apply 'mapcar (cons '+ apt)))
)
(vlax-3D-point
(mapcar '* '(0.5 0.5) (apply 'mapcar (cons '+ bpt)))
)
)
(vla-ScaleEntity
obj
(vlax-3D-point
(mapcar '* '(0.5 0.5) (apply 'mapcar (cons '+ bpt)))
)
sc
)
)
(prompt "\n选择需要套图框的图形或[空格(退出)]：")
)
(princ)
)

(defun c:tt (/ tk tklst apt bpt ty sc obj) 
  (vl-load-com) 
  (prompt "选择图框：") 
  (setq tk (ssget)) 
  (setq 
    apt 
     (car 
       (mapcar '(lambda        (x) 
                  (vla-GetBoundingBox 
                    (vlax-ename->vla-object x) 
                    'minpt 
                    'maxpt 
                  ) 
                  (list        (vlax-safearray->list minpt) 
                        (vlax-safearray->list maxpt) 
                  ) 
                ) 
               (vl-remove-if-not 
                 '(lambda (x) (= 1 (cdr (assoc 62 (entget x))))) 
                 (setq tklst (vl-remove-if-not 
                               '(lambda (x) (= 'ENAME (type x))) 
                               (apply 'append (ssnamex tk)) 
                             ) 
                 ) 
               ) 
       ) 
     ) 
  ) 
  (prompt "\n选择需要套图框的图形：") 
  (while (setq ty (ssget)) 
    (setq 
      bpt (apply 'append 
                 (mapcar '(lambda (x) 
                            (vla-GetBoundingBox 
                              (vlax-ename->vla-object x) 
                              'minpt 
                              'maxpt 
                            ) 
                            (list (mapcar '* 
                                          '(1.0 1.0) 
                                          (vlax-safearray->list minpt) 
                                  ) 
                                  (mapcar '* 
                                          '(1.0 1.0) 
                                          (vlax-safearray->list maxpt) 
                                  ) 
                            ) 
                          ) 
                         (vl-remove-if-not 
                           '(lambda (x) (= 'ENAME (type x))) 
                           (apply 'append (ssnamex ty)) 
                         ) 
                 ) 
          ) 
    ) 
    (setq bpt (list (mapcar '- (apply 'mapcar (cons 'min bpt)) '(5 5)) 
                    (mapcar '+ (apply 'mapcar (cons 'max bpt)) '(5 5)) 
              ) 
    ) 
    (setq sc (apply 'max 
                    (mapcar '/ 
                            (apply 'mapcar (cons '- (reverse bpt))) 
                            (apply 'mapcar (cons '- (reverse apt))) 
                    ) 
             ) 
    ) 
    (foreach n tklst 
      (setq obj (vla-copy (vlax-ename->vla-object n))) 
      (vla-move        obj 
                (vlax-3D-point 
                  (mapcar '* '(0.5 0.5) (apply 'mapcar (cons '+ apt))) 
                ) 
                (vlax-3D-point 
                  (mapcar '* '(0.5 0.5) (apply 'mapcar (cons '+ bpt))) 
                ) 
      ) 
      (vla-ScaleEntity 
        obj 
        (vlax-3D-point 
          (mapcar '* '(0.5 0.5) (apply 'mapcar (cons '+ bpt))) 
        ) 
        sc 
      ) 
    ) 
    (prompt "\n选择需要套图框的图形或[空格(退出)]：") 
  ) 
  (princ) 
)

;图框中间矩形框为红色，才能识别。

alexmai · 发表于 2021-9-6 11:57:04

yanchao316 发表于 2021-9-6 10:14
是换不同单位图框，套框方法统一不了。

https://mp.weixin.qq.com/s/ospTcU37yteunZvN_sYtuQ

只能帮到这了

alexmai · 发表于 2021-9-4 21:40:10

yanchao316 发表于 2021-8-26 17:38
经常遇到换图框，然后要复制原图名等相关信息。为避免看错、看漏，会将图框套好的图框相对原图形上偏移一定 ...

图框用外部参照的，图框内文字用属性块做，块插入点都在右下角，以后换啥图框，替换一下文件就搞定，100张图全换也花不了5分钟，改属性块命令就是在位编辑，编辑完后， (command "_attsync" "" (ssget) "y")

yanchao316 · 发表于 2021-8-27 10:23:16

kkq0305 发表于 2021-8-26 19:49
如果不想缩放图框 sc赋值 1 就行或者把缩放相关代码删除就行

要缩放，只是想要套好的图框位置整体向某一边移动，非完全重合。开始的建议基本上能满足了，谢谢。

yanchao316 · 发表于 2021-8-26 15:46:44

本帖最后由 yanchao316 于 2021-8-27 10:23 编辑

测试了，很实用，谢谢分享！

yanchao316 · 发表于 2021-8-26 17:38:54

经常遇到换图框，然后要复制原图名等相关信息。为避免看错、看漏，会将图框套好的图框相对原图形上偏移一定距离（距离是相同比例）或右偏移一定距离，改完后，再把图框移到正确位置。请问怎么改下楼主的工具达到这个目的？

kkq0305 · 发表于 2021-8-26 17:44:41

yanchao316 发表于 2021-8-26 17:38
经常遇到换图框，然后要复制原图名等相关信息。为避免看错、看漏，会将图框套好的图框相对原图形上偏移一定 ...

哪里有四个5 可以对这个进行修改

yanchao316 · 发表于 2021-8-26 18:37:15

多谢！基本上能满足了。如果是针对不同大小图框，能等比例的偏移就更好了。

kkq0305 · 发表于 2021-8-26 19:49:00

yanchao316 发表于 2021-8-26 18:37
多谢！基本上能满足了。如果是针对不同大小图框，能等比例的偏移就更好了。

如果不想缩放图框 sc赋值 1 就行或者把缩放相关代码删除就行

yanchao316 · 发表于 2021-9-6 10:14:32

alexmai 发表于 2021-9-4 21:40
图框用外部参照的，图框内文字用属性块做，块插入点都在右下角，以后换啥图框，替换一下文件就搞定，100 ...

是换不同单位图框，套框方法统一不了。

账号		自动登录	找回密码
密码			注册

[源码] 套图框(练手作)

评分

本帖子中包含更多资源