本帖最后由 CAD新军 于 2019-12-9 14:55 编辑
一般我用Lee Mac的CBPR/CBP命令改基点，那个会迭代进嵌套块移动嵌套在里面的块的位置保证屏幕位置不变。
在学习参照坐标点变换时顺便改进了一下两套工具，分别是ID @自贡黄明儒 的LISP操作快和langjs 的相同刷 刷块部分，用的是同几行代码
这是修改
 - ;;[功能] 修改块插入基点
- (defun C:ReInsertP (/ E EN ENT N OBJ OLDNAME P PT ent_vec ent_insertionPoint SS)
- (cond
- ((and (setq ss (ssget "_+.:E:S" '((0 . "INSERT"))))
- ;;(setq NewName (rtos (* (getvar "CDATE") 1E8)))
- (setq en (ssname ss 0))
- (setq ent (entget en))
- (setq obj (vlax-ename->vla-object en))
- (setq oldName (vlax-get obj 'Name))
- (setq p (vlax-get obj 'InsertionPoint))
- (setq pt (getpoint p "\n块新基点"))
- )
- (setq pt (mapcar '- pt p))
- (setq pt (MAT:Rot2D pt (- 0 (cdr (assoc 50 ent)))));
- (setq pt (mapcar '(lambda( i j )(/ i j )) pt (list (cdr (assoc 41 ent)) (cdr (assoc 42 ent)) )))
-
- (_BlockNewName oldName nil pt nil nil "")
- ;;使块原位不动
- (setq ss (ssget "X" (list '(0 . "INSERT") (cons 2 oldName))))
- (repeat (setq n (sslength ss))
- (entupd (setq e (ssname ss (setq n (1- n)))))
- (setq ent (entget e))
- (setq ent_insertionPoint (cdr (assoc 10 ent)))
- (setq ent_vec (mapcar '(lambda( i j )(* i j )) pt (list (cdr (assoc 41 ent)) (cdr (assoc 42 ent)) ))) ;
- (setq ent_vec (MAT:Rot2D ent_vec (cdr (assoc 50 ent))))
- (setq ent_insertionPoint (mapcar '+ ent_insertionPoint ent_vec))
- (entmod (subst (cons 10 ent_insertionPoint) (assoc 10 ent) ent))
- )
- )
- )
- (princ)
- )
这是相同刷 刷块的。我改成了用块刷另外一个块，而不是用一个块刷所有块。这就给了相对基点的空间。
- ((= ty "INSERT") ; 4、 如果源对象是块，则拷贝源块到目标块的位置，删除目标块
- (setq replaceblkname (cdr (assoc 2 ent)))
- (princ (strcat " \n选择一个目标块参照<刷成:" replaceblkname ">"))
- ; 修改为一次只能刷一种块，先点选，然后再框选。这样的好处是相对坐标可以处理了，实际使用应该比用一个块刷不同块更多
- (setq uu (cdr (assoc 10 ent)))
- (setq model_ent (entget (ssname (ssget ":S" '((0 . "INSERT"))) 0 )) )
- (setq model_name (cdr(assoc 2 model_ent)))
- (setq model_insertionpoint (cdr (assoc 10 model_ent)))
- (setq model_basepoint (getpoint model_insertionpoint "请选择相对新块插入基点（空值为旧块的基点）"))
- (if (null model_basepoint)
- (setq model_basepoint model_insertionpoint)
- )
- (setq vec (mapcar '- model_basepoint model_insertionpoint))
- (setq vec (MAT:Rot2D vec (- 0 (cdr (assoc 50 model_ent)))));先转回和WCS正交 这个角度要顺时针
- (setq std_vec (mapcar '(lambda( i j )(/ i j )) vec (list (cdr (assoc 41 model_ent)) (cdr (assoc 41 model_ent)) ))) ;
-
- (while t
- (princ " \n选择目标对象:<块相同>")
- ;(if (setq ss (ssget ":S:L" (list '(0 . "INSERT") (cons 2 model_name))))
- (if (setq ss (ssget (list '(0 . "INSERT") (cons 2 model_name))))
- (progn
- ; (vl-cmdf "")
- (repeat (setq i (sslength ss))
- (setq en1 (ssname ss (setq i (1- i))))
- (setq ent (entget en1))
- (setq ent_insertionPoint (cdr (assoc 10 ent)))
- (setq obj (vlax-ename->vla-object en1))
- (vlax-put-property obj 'NAME replaceblkname)
- (setq ent_vec (mapcar '(lambda( i j )(* i j )) std_vec (list (cdr (assoc 41 ent)) (cdr (assoc 42 ent)) ))) ;
- (setq ent_vec (MAT:Rot2D ent_vec (cdr (assoc 50 ent))))
- (setq ent_insertionPoint (mapcar '+ ent_insertionPoint ent_vec))
-
- (vlax-put-property obj "InsertionPoint" (vlax-3d-point ent_insertionPoint ));
-
- )
- )
- )
- (52errno)
- )
- )
实际用途。。。比如建筑给你一堆图纸，它们作图比较随意，图框基点十万八千里，你要套图就要一个一个换图框，不同比例还要缩放一下，用这个设定好相对基点一刷就全套上了
代码都给了，会的自己复制，不会的下载，收点币维持买帖子学习的经费，收到10个币以后免费
*更新*根据承诺，收费够了，取消下载论坛币
| 
发表于 2019-9-27 17:28
置顶卡
变色卡
显身卡
再次使用又循环一下 最后还是要重启
楼主
