将块内标注在块外重新生成
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;[功能]将块内标注在块外重新生成
;;只重生块内采用dimlinear 采用dimaligned，其余标注删除
;;将块内(0 0)转到世界坐标系(MAT:TransNested '(0 0) (list e) 2 0)
;;第1步，找到块内标注，假如只有一个，并删除(vla-delete (vlax-ename->vla-object (car (nentsel))))
;;第2步，所有同名块列表
;;第3步，找到标注的三个点
;;第4步，分别把三个对各块转换，重新生成标注
(defun C:RD (/ E EN NAME SS)
(vl-cmdf ".采用ucs" "");以简化程序
(while (setq ss (LM:ssget "\n >选择块<移出块内标注>:" '(((0 . "INSERT")))))
(setq e (ssname ss 0))
(setq en (entget e))
(setq name (cdr (assoc 2 en)))
(setq ss (ssget "X" (list '(0 . "INSERT") (cons 2 name))))
(采用HH:RD ss name)
)
(princ"\n 重生块内采用dimlinear 采用dimaligned，其余标注删除")
(princ)
)
(princ"\n 命令:RD,重生块内采用dimlinear 采用dimaligned，其余标注删除")
(princ)
(defun 采用HH:RD (ss name / B1 B1DEL EN FLAG L P1 P2 P3 str1)
(setq b1 (TBLOBJNAME "block" name))
;;第1步，找到块内标注，假如只有一个，并删除(vla-delete (vlax-ename->vla-object (car (nentsel))))
(setq Flag T)
(while (and Flag (setq b1 (entnext b1)))
(setq en (entget b1))
(setq name (cdr (assoc 0 en)))
(if(wcmatch name "*DIMENSION")
(progn
(setq Flag nil)
(setq b1Del b1)
)
)
)
(if (not (wcmatch name "*DIMENSION"))
(alert "块内没有标注")
(progn
(setq name (cdr (assoc 2 en)));块名
(setq b1 (TBLOBJNAME "block" name))
;;第3步，找到标注的三个点
(setq Flag T)
(while (and Flag (setq b1 (entnext b1)))
(setq en (entget b1))
(if (= (cdr (assoc 0 en)) "MTEXT")
(progn
;;非等比块要改为假尺寸
(setq str1 (cdr (assoc 1 en)))
(setq p1 (cdr (assoc 10 en)))
(setq b1 (entnext b1))
(setq en (entget b1));第1个"POINT"
(setq p2 (cdr (assoc 10 en)))
(setq b1 (entnext b1))
(setq en (entget b1));第2个"POINT"
(setq p3 (cdr (assoc 10 en)))
(setq Flag nil)
)
)
)
)
)
(if (and (vl-consp p1) (vl-consp p2) (vl-consp p3))
(progn
;;选择集转为vla列表
(setq L (LM:ss->vla ss))
(vla-delete (vlax-ename->vla-object b1Del));删除块内对象
(mapcar (function (lambda(x) (vla-update x))) L )
(采用HH:RD:do p1 p2 p3 L str1)
)
(prompt "\n ......标注异常，没找到标注的3个定位点")
)
)
页:
[1]