乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
楼主: Jaap Marchal

[编程交流] 替换对象(矩形)

[复制链接]

13

主题

46

帖子

33

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
65
发表于 2022-7-5 17:10:30 | 显示全部楼层
两个都请。。。。。。。。。。。
回复

使用道具 举报

13

主题

46

帖子

33

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
65
发表于 2022-7-5 17:14:38 | 显示全部楼层
 
 
 
你好,李,
 
serateLisp程序可以
 
Jaap公司
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 17:15:50 | 显示全部楼层
嗨,李,
 
是否可以根据矩形/多边形方向对块进行定向,并根据要替换的矩形/多边形的大小调整同一块的大小。我附上了一个样本cad文件-矩形。dwg和块文件-vault。图纸。
 
谢谢
矩形。图纸
金库图纸
回复

使用道具 举报

13

主题

46

帖子

33

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
65
发表于 2022-7-5 17:20:13 | 显示全部楼层
 
感谢李:
 
这是一个很好的起点,我选择了一个块在绘图,然后用它作为替代。
 
我的编辑如下:
  1. (defun c:ctb ( / *error* _StartUndo _EndUndo doc spc ss ll ur )
  2. (vl-load-com)
  3. ;; Lee Mac 2010 - www.lee-mac.com
  4. (defun *error* ( msg )
  5.    (if doc (_EndUndo doc))
  6.    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
  7.        (princ (strcat "\n** Error: " msg " **")))
  8.    (princ)
  9. )
  10. (defun _StartUndo ( doc ) (_EndUndo doc)
  11.    (vla-StartUndoMark doc)
  12. )
  13. (defun _EndUndo ( doc )
  14.    (if (= 8 (logand 8 (getvar 'UNDOCTL)))
  15.      (vla-EndUndoMark doc)
  16.    )
  17. )
  18. (LM:ActiveSpace 'doc 'spc)
  19. (if (and (setq *dwg (getfiled "Select Block" (vl-filename-directory (cond ( *dwg ) ( "" ))) "dwg" 16))
  20.           (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons 410 (getvar 'CTAB)))))
  21.    (progn
  22.      (_StartUndo doc)
  23.      
  24.      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
  25.        (vla-getBoundingBox obj 'll 'ur)
  26.        (
  27.          (lambda ( block )
  28.            (mapcar
  29.              (function
  30.                (lambda ( p )
  31.                  (vlax-put-property block p (vlax-get-property obj p))
  32.                )
  33.              )
  34.              '(Layer Linetype Lineweight)
  35.            )
  36.            (
  37.              (lambda ( hyp )
  38.                (vlax-for h (vla-get-HyperLinks obj)
  39.                  (vla-Add hyp (vla-get-Url h) (vla-get-UrlDescription h) (vla-get-UrlNamedLocation h))
  40.                )
  41.              )
  42.              (vla-get-HyperLinks block)
  43.            )
  44.          )
  45.          (vla-InsertBlock spc
  46.            (vlax-3D-point
  47.              (apply 'mapcar
  48.                (cons '(lambda ( a b ) (/ (+ a b) 2.))
  49.                  (mapcar 'vlax-safearray->list (list ll ur))
  50.                )
  51.              )
  52.            )
  53.            *dwg 1. 1. 1. 0.
  54.          )
  55.        )
  56.        (vla-delete obj)
  57.      )
  58.      (vla-delete ss) (_EndUndo doc)
  59.    )
  60. )
  61. (princ)
  62. )
  63. ;;--------------------=={ ActiveSpace }==---------------------;;
  64. ;;                                                            ;;
  65. ;;  Retrieves pointers to the Active Document and Space       ;;
  66. ;;------------------------------------------------------------;;
  67. ;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
  68. ;;------------------------------------------------------------;;
  69. ;;  Arguments:                                                ;;
  70. ;;  *doc - quoted symbol (other than *doc)                    ;;
  71. ;;  *spc - quoted symbol (other than *spc)                    ;;
  72. ;;------------------------------------------------------------;;
  73. (defun LM:ActiveSpace ( *doc *spc )
  74. ;; © Lee Mac 2010
  75. (set *spc
  76.    (vlax-get-property
  77.      (set *doc
  78.        (vla-get-ActiveDocument
  79.          (vlax-get-acad-object)
  80.        )
  81.      )
  82.      (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)
  83.    )
  84. )
  85. )
回复

使用道具 举报

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 17:22:30 | 显示全部楼层
回复

使用道具 举报

13

主题

46

帖子

33

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
65
发表于 2022-7-5 17:28:33 | 显示全部楼层
Both please ...........
回复

使用道具 举报

13

主题

46

帖子

33

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
65
发表于 2022-7-5 17:31:44 | 显示全部楼层
 
 
 
Hello Lee,
 
A serate lisp is OK
 
Jaap
回复

使用道具 举报

1

主题

9

帖子

2

银币

初来乍到

Rank: 1

铜币
12
发表于 2022-7-5 17:32:33 | 显示全部楼层
Hi Lee,
 
Is it possible for the block to be orientated according to the rectangle/polygon orientation and resize the same block according to the size of the rectangle/polygon to be replaced. I have attached a sample cad file - rectangle.dwg and a block file - vault.dwg.
 
Thanks
rectangles.dwg
Vault.dwg
回复

使用道具 举报

56

主题

256

帖子

230

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
253
发表于 2022-7-5 17:36:39 | 显示全部楼层
 
Thanks Lee for this:
 
It was a good starting point for me to pick a block in the drawing and then use that as the replace.
 
My edit below:
  1. (defun c:BK_Replace_With_Object ( / *error* _StartUndo _EndUndo doc spc ss ll ur )(vl-load-com) ;; Lee Mac 2010 - www.lee-mac.com (defun *error* ( msg )         (if doc (_EndUndo doc))         (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")                 (princ (strcat "\n** Error: " msg " **")))         (princ)         ) (defun _StartUndo ( doc ) (_EndUndo doc)         (vla-StartUndoMark doc)         ) (defun _EndUndo ( doc )         (if (= 8 (logand 8 (getvar 'UNDOCTL)))                 (vla-EndUndoMark doc)                 )         ) (LM:ActiveSpace 'doc 'spc) (if         (and        ; Old Code by LeeMac        ; (setq *dwg (getfiled "Select Block" (vl-filename-directory (cond ( *dwg ) ( "" ))) "dwg" 16))        ; EDIT by 3dwannab 15-03-18        (cond                (                        (and                                (setq *dwg (car (entsel "\nSelect Block Entity: ")))                                (eq (cdr (assoc 0 (entget *dwg))) "INSERT")                                (setq *dwg (vla-get-effectivename (vlax-ename->vla-object *dwg)))                                )                        )                )                ;; End EDIT                (ssget "_:L" (list (cons 0 "LWPOLYLINE") (cons 410 (getvar 'CTAB))))                )         (progn                 (_StartUndo doc)                 (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))                         (vla-getBoundingBox obj 'll 'ur)                         (                                 (lambda ( block )                                         (mapcar                                                 (function                                                         (lambda ( p )                                                                 (vlax-put-property block p (vlax-get-property obj p))                                                                 )                                                         )                                                 '(Layer Linetype Lineweight)                                                 )                                         (                                                 (lambda ( hyp )                                                         (vlax-for h (vla-get-HyperLinks obj)                                                                 (vla-Add hyp (vla-get-Url h) (vla-get-UrlDescription h) (vla-get-UrlNamedLocation h))                                                                 )                                                         )                                                 (vla-get-HyperLinks block)                                                 )                                         )                                 (vla-InsertBlock spc                                         (vlax-3D-point                                                 (apply 'mapcar                                                         (cons '(lambda ( a b ) (/ (+ a b) 2.))                                                                 (mapcar 'vlax-safearray->list (list ll ur))                                                                 )                                                         )                                                 )                                         *dwg 1. 1. 1. 0.                                         )                                 )                         (vla-delete obj)                         )                 (vla-delete ss) (_EndUndo doc)                 )         ) (princ) );;--------------------=={ ActiveSpace }==---------------------;;;;                                                            ;;;;  Retrieves pointers to the Active Document and Space       ;;;;------------------------------------------------------------;;;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;;;------------------------------------------------------------;;;;  Arguments:                                                ;;;;  *doc - quoted symbol (other than *doc)                    ;;;;  *spc - quoted symbol (other than *spc)                    ;;;;------------------------------------------------------------;;(defun LM:ActiveSpace ( *doc *spc ) ;; © Lee Mac 2010 (set *spc         (vlax-get-property                 (set *doc                         (vla-get-ActiveDocument                                 (vlax-get-acad-object)                                 )                         )                 (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)                 )         ) )(princ(strcat        "\n##############################################################"        "\n_____________ Loaded 'BK_Replace_With_Object.lsp'_____________"        "\n____________ Type 'BK_Replace_With_Object' to run_____________"        "\n##############################################################"        ))(princ)
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-14 15:46 , Processed in 1.811325 second(s), 68 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表