你好，李，
serateLisp程序可以
Jaap公司 嗨，李，
是否可以根据矩形/多边形方向对块进行定向，并根据要替换的矩形/多边形的大小调整同一块的大小。我附上了一个样本cad文件-矩形。dwg和块文件-vault。图纸。
谢谢
矩形。图纸
金库图纸
感谢李：
这是一个很好的起点，我选择了一个块在绘图，然后用它作为替代。
我的编辑如下：
(defun c:ctb ( / *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 (setq *dwg (getfiled "Select Block" (vl-filename-directory (cond ( *dwg ) ( "" ))) "dwg" 16))
(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)
)
)
) Both please ...........
Hello Lee,
A serate lisp is OK
Jaap 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
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:
(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)
页:
1
[2]