[求助]标注打断

头大无恼 · 发表于 2012-7-3 11:17:14

本帖最后由头大无恼于 2012-7-3 11:18 编辑

有时候标注对象修改了，再修改标注很繁琐要两三个步骤，有没有可能打断重标。

见图示：只要重新选择标注点就自动改标注

懒人先行谢过

hao3ren · 发表于 2012-7-3 12:39:10

;;; |标注合并和断开程序
;;; |断开dimbreak,合并dimcombine
;;; |snsj 2004.4.8
(defun zm (et x /)
(cdr (assoc x (entget et)))
)
(defun pzm (nwzm y obj /)
(entmod (subst
(cons y nwzm)
(assoc y (entget obj))
(entget obj)
)
)
)
(defun objnm (ent)
(vla-get-objectname (vlax-ename->vla-object ent))
)
(defun maxlst (pts / js i x tt jl ds)
(setq js 0
i 0
)
(repeat (length pts)
(setq tt (nth i pts))
(mapcar
'(lambda (x)
(if (> (setq ds (distance tt x))
js
)
(setq js ds
jl (list x tt)
)
)
)
pts
)
(setq i (1+ i))
)
jl
)
;;; |标注断开
(defun c:dd (/ ENT ENT1 GETPT JPT PT1 PT2 XL)
(vl-load-com)
(vl-cmdf "undo" "be")
(if (setq ent (car (entsel "\n选择要断开的标注<退出>:")))
(progn
(redraw ent 3)
(setq getpt (getpoint "\n点取断开点:"))
(redraw ent 4)
(vl-cmdf ".copy" ent "" '(0 0) "@")
(setq ent1 (entlast))
(setq pt1 (zm ent 13)
pt2 (zm ent 14)
)
(if (= (objnm ent) "AcDbAlignedDimension")
(vl-cmdf ".xline" pt1 pt2 "")
(vl-cmdf ".xline" "a" (angtos (zm ent 50) 0 4) pt1 "")
)
(setq xl (entlast))
(pzm (setq jpt (vlax-curve-getClosestPointTo xl getpt))
13 ent
)
(pzm jpt 14 ent1)
(vl-cmdf ".erase" xl "")
)
)
(vl-cmdf "undo" "e")
(princ)
)
;;; |标注合并
(defun c:bb (/ ANG1 ANG2 ENT ENT1 MAXPT PT1 PT2 PT3 PT4 PT5 PT6 PT7
XL
)
(vl-load-com)
(vl-cmdf "undo" "be")
(if (setq ent (car (entsel "\n选择要合并对标注<退出>:")))
(progn
(redraw ent 3)
(setq ent1 (car (entsel "\n选择另一个标注对象<退出>:")))
(redraw ent 4)
(setq pt1 (zm ent 13)
pt2 (zm ent 14)
pt3 (zm ent1 13)
pt4 (zm ent1 14)
)
(if (= (objnm ent) "AcDbAlignedDimension")
(setq ang1 (angle pt1 pt2))
(setq ang1 (zm ent 50))
)
(if (= (objnm ent1) "AcDbAlignedDimension")
(setq ang2 (angle pt3 pt4))
(setq ang2 (zm ent1 50))
)
(if (or
(or
(equal ang2 ang1 0.00001)
(equal (+ pi ang2) ang1 0.00001)
)
(equal (- ang2 pi) ang1 0.00001)
)
(progn
(vl-cmdf ".xline" "a" (angtos ang1 0 4) pt1 "")
(setq xl (entlast))
(setq pt5 (vlax-curve-getClosestPointTo xl pt2)
pt6 (vlax-curve-getClosestPointTo xl pt3)
pt7 (vlax-curve-getClosestPointTo xl pt4)
)
(setq maxpt (maxlst (list pt1 pt5 pt6 pt7)))
(pzm (car maxpt) 13 ent)
(pzm (cadr maxpt) 14 ent)
(vl-cmdf ".erase" xl ent1 "")
)
)
)
)
(vl-cmdf "undo" "e")
(princ)
)

;;; |标注合并和断开程序 
;;; |断开dimbreak,合并dimcombine 
;;; |snsj 2004.4.8 
(defun zm (et x /) 
        (cdr (assoc x (entget et))) 
) 
(defun pzm (nwzm y obj /) 
        (entmod (subst 
                                                (cons y nwzm) 
                                                (assoc y (entget obj)) 
                                                (entget obj) 
                                        ) 
        ) 
) 
(defun objnm (ent) 
        (vla-get-objectname (vlax-ename->vla-object ent)) 
) 
(defun maxlst (pts / js i x tt jl ds) 
        (setq js 0 
                                i 0 
        ) 
        (repeat (length pts) 
                (setq tt (nth i pts)) 
                (mapcar 
                        '(lambda (x) 
                                 (if (> (setq ds (distance tt x)) 
                                                                js 
                                                 ) 
                                         (setq js ds 
                                                                 jl (list x tt) 
                                         ) 
                                 ) 
                         ) 
                        pts 
                ) 
                (setq i (1+ i)) 
        ) 
        jl 
) 
;;; |标注断开 
(defun c:dd (/ ENT ENT1 GETPT JPT PT1 PT2 XL) 
        (vl-load-com) 
        (vl-cmdf "undo" "be") 
        (if (setq ent (car (entsel "\n选择要断开的标注<退出>:"))) 
                (progn 
                        (redraw ent 3) 
                        (setq getpt (getpoint "\n点取断开点:")) 
                        (redraw ent 4) 
                        (vl-cmdf ".copy" ent "" '(0 0) "@") 
                        (setq ent1 (entlast)) 
                        (setq pt1 (zm ent 13) 
                                                pt2 (zm ent 14) 
                        ) 
                        (if (= (objnm ent) "AcDbAlignedDimension") 
                                (vl-cmdf ".xline" pt1 pt2 "") 
                                (vl-cmdf ".xline" "a" (angtos (zm ent 50) 0 4) pt1 "") 
                        ) 
                        (setq xl (entlast)) 
                        (pzm (setq jpt (vlax-curve-getClosestPointTo xl getpt)) 
                                         13 ent 
                        ) 
                        (pzm jpt 14 ent1) 
                        (vl-cmdf ".erase" xl "") 
                ) 
        ) 
        (vl-cmdf "undo" "e") 
        (princ) 
) 
;;; |标注合并 
(defun c:bb (/ ANG1 ANG2 ENT ENT1 MAXPT PT1 PT2 PT3 PT4 PT5 PT6 PT7 
                                                                                         XL 
                                                                                ) 
        (vl-load-com) 
        (vl-cmdf "undo" "be") 
        (if (setq ent (car (entsel "\n选择要合并对标注<退出>:"))) 
                (progn 
                        (redraw ent 3) 
                        (setq ent1 (car (entsel "\n选择另一个标注对象<退出>:"))) 
                        (redraw ent 4) 
                        (setq pt1 (zm ent 13) 
                                                pt2 (zm ent 14) 
                                                pt3 (zm ent1 13) 
                                                pt4 (zm ent1 14) 
                        ) 
                        (if (= (objnm ent) "AcDbAlignedDimension") 
                                (setq ang1 (angle pt1 pt2)) 
                                (setq ang1 (zm ent 50)) 
                        ) 
                        (if (= (objnm ent1) "AcDbAlignedDimension") 
                                (setq ang2 (angle pt3 pt4)) 
                                (setq ang2 (zm ent1 50)) 
                        ) 
                        (if (or 
                                                (or 
                                                        (equal ang2 ang1 0.00001) 
                                                        (equal (+ pi ang2) ang1 0.00001) 
                                                ) 
                                                (equal (- ang2 pi) ang1 0.00001) 
                                        ) 
                                (progn 
                                        (vl-cmdf ".xline" "a" (angtos ang1 0 4) pt1 "") 
                                        (setq xl (entlast)) 
                                        (setq pt5 (vlax-curve-getClosestPointTo xl pt2) 
                                                                pt6 (vlax-curve-getClosestPointTo xl pt3) 
                                                                pt7 (vlax-curve-getClosestPointTo xl pt4) 
                                        ) 
                                        (setq maxpt (maxlst (list pt1 pt5 pt6 pt7))) 
                                        (pzm (car maxpt) 13 ent) 
                                        (pzm (cadr maxpt) 14 ent) 
                                        (vl-cmdf ".erase" xl ent1 "") 
                                ) 
                        ) 
                ) 
        ) 
        (vl-cmdf "undo" "e") 
        (princ) 
)

longer1000 · 发表于 2012-7-3 13:17:57

楼上的谢了！！！！！！！！！

头大无恼 · 发表于 2012-7-4 09:04:18

能加个循环就好可以连续打断

Andyhon · 发表于 2012-7-4 09:39:42

(if (setq ent (car (entsel "\n选择要断开的标注<退出>:")))
(progn
 (redraw ent 3)
 (setq getpt (getpoint "\n点取断开点:"))

===>

(while (and
 (princ "\n选择要断开的标注<退出>:")
 (setq ent (ssget ":E:S" '((0 . "DIMENSION"))))
 )
(setq ent (ssname ent 0))
(redraw ent 3)
(setq getpt (getpoint "\n点取断开点:"))

Ccccccc · 发表于 2012-7-4 13:45:26

Andyhon 发表于 2012-7-4 09:39
(if (setq ent (car (entsel "\n选择要断开的标注:")))
(progn
(redraw ent 3)

请教这个怎样改为连续打断，谢谢【】、
(defun c:DimBreak (/ ent ent1 getpt jpt pt1 pt2)
 (setq ent (car (entsel "\n选择要断开的标注<退出>:")))
 (or ent (fsxm-silenceexit))
 (setq getpt (getpoint "\n点取断开点:"))
 (or getpt (fsxm-silenceexit))
 (setvar "cmdecho" 0)
 (vl-cmdf "undo" "be")
 (vl-cmdf ".copy" ent "" '(0 0) "@")
 (setq ent1 (entlast))
 (setq pt1 (fsxm-getendxf ent 13))
 (if (= (vla-get-objectname (vlax-ename->vla-object ent))
 "AcDbAlignedDimension"
 )
(setq pt2 (fsxm-getendxf ent 14))
(setq pt2 (polar pt1 (fsxm-getendxf ent 50) 1))
 )
 (setq jpt (fsxm-pt-prj (trans getpt 1 0) pt1 pt2))
 (fsxm-setendxf ent 13 jpt)
 (fsxm-setendxf ent1 14 jpt)
 (vl-cmdf "undo" "e")
 (princ)
)

头大无恼 · 发表于 2012-7-6 12:43:14

(if (setq ent (car (entsel "\n选择要断开的标注<退出>:")))
(progn
 (redraw ent 3)
 (setq getpt (getpoint "\n点取断开点:"))
===========>改为
(while (and
 (princ "\n选择要断开的标注<退出>:")
 (setq ent (ssget ":E:S" '((0 . "DIMENSION"))))
 )
 (setq ent (ssname ent 0))
 (progn
 (redraw ent 3)
 (setq getpt (getpoint "\n点取断开点:"))

myfrankie · 发表于 2015-11-9 15:02:39

hao3ren 发表于 2012-7-3 12:39

为什么断开后，标注会跑很远？？

淡淡的忧伤2012 · 发表于 2015-12-15 13:00:28

是直接复制代码，然后直接新建一个TEXT，然后改后缀名嘛（LSP）但是为什么你们讨论的这些代码，我都没成功啊，我用的是AUTOCAD2010 求解

账号		自动登录	找回密码
密码			注册

[求助]标注打断

本帖子中包含更多资源

评分

评分