申请编辑两个程序

bios

命令1:点取现有的标注形式为当前标注形式,由于标注格式多了,经常遇到要切换标注格式的问题


命令2:查看两线是否重合,由于常常遇到两线挨得很近 的问题,有些又上是重合的.,没注意很容易出现画图误差

meflying

1、 (defun c:test( / ent dimstyle)
(setq ent (car (entsel "选择标注...")))
(setq dimstyle (cdr (assoc 3 (entget ent))))
(command "_.dimstyle" "r" dimstyle)
(princ)
) 2、参考 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=10613

bios

还有的东西要申请，我在基础版面上有写，不用在多发水贴，就在着楼下写了


申请一个交点打断的命令。框选之后就能打断所选的线段。 3q

雪山飞狐_lzh

贴个VBA的，可以打断直线、圆弧、圆和椭圆要引用TLSBOUNBARY类（不过Spline不支持） TLSBOUNBARY类：dispbbs.asp?boardID=4&ID=20994&page=2

2. Sub Sample_TlsBoundary_Break()
3.        Dim pBoundary As New TlsBoundary
4.        Dim SS As AcadSelectionSet
5.        Dim pnts As Variant
6.        Dim i As AcadEntity
7.        Dim ft(0) As Integer, fd(0)
8.        ft(0) = 0
9.        fd(0) = "Line,Circle,Arc,Ellipse"
10.        Set SS = ThisDrawing.ActiveSelectionSet
11.        pBoundary.WorkSpace = SS
12.        SS.SelectOnScreen ft, fd
13.        pBoundary.BreakAllAtPoint
14. End Sub

Sub Sample_TlsBoundary_Break()        Dim pBoundary As New TlsBoundary        Dim SS As AcadSelectionSet        Dim pnts As Variant        Dim i As AcadEntity        Dim ft(0) As Integer, fd(0)        ft(0) = 0        fd(0) = "Line,Circle,Arc,Ellipse"        Set SS = ThisDrawing.ActiveSelectionSet        pBoundary.WorkSpace = SS        SS.SelectOnScreen ft, fd        pBoundary.BreakAllAtPoint End Sub