社区 › AutoLISP/Visual LISP 编程技术 › 套图框(练手作)

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)
)
;图框中间矩形框为红色，才能识别。

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 ...

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

查看完整版本: 套图框(练手作)