[求助]：求一个思路！只说说思路就可以了！

laoliu09

我想用VBA编一个修剪对齐标注尺寸界线的程序，其实是想模仿天正建筑的修剪尺寸界线的方法，我一开始是想通过修改标注原点来实现的，但发现尺寸线也跟着有一小段位移，按照常规想法，尺寸线应该不动才对。而用天正建筑的修剪尺寸界线里就没有这个现象！但我想原理是差不多的，真不知道为什么啊！希望有人能帮我写一个，或给点提示也好！这困惑了我好久啊！另外，我用其他方法也可以实现，但稍微复杂一点，要通过扩展数据才可以实现，但个别情况下不尽人意。这个问题的关键是：实现这个效果到底是不是修改对齐标注的原点就可以，怎样确保尺寸线不要随着对齐标注原点的变化而移动。但我想除了修改对齐标注的原点外，好像没什么办法了吧，不知道我想歪了没有，急需高手指点！谢谢！

tc405003

(defun c:TT (/ ang e en j len olderr os pt1 pt2 pt3 pt4 ss aeoerr
                     trim-dim dxf
                  )
  (defun dxf(a b)(cdr(assoc a b)))
  (defun aeoerr (msg)
    (command "_.undo" "end" ^c)
    (setvar "osmode" os)
    (setq *error* olderr)
  )
  (defun TT (pt1 pt2 ss / ent entl i np13 np14 p10 p13 p14 ptt)
  ; 这一; 段改自"程序（函数）库"
    (setq pt1 (trans pt1 1 0)
          pt2 (trans pt2 1 0)
          i 0
    )
    (repeat (sslength ss)
      (setq ent (ssname ss i)
            entl (entget ent)
            p10 (cdr (assoc 10 entl))
            p13 (cdr (assoc 13 entl))
            p14 (cdr (assoc 14 entl))
            ptt (cdr (assoc 11 entl))
            i (1+ i)
            np14 (inters
                   pt1
                   pt2
                   p14
                   p10
                   nil
                 )
      )
      (if (not (member '(100 . "AcDbRotatedDimension") entl))
        (setq np13 (polar np14 (angle p14 p13) (distance p14 p13)))
        (setq np13 (inters
                     pt1
                     pt2
                     p13
                     (polar p13 (angle p14 p10) 100)
                     nil
                   )
        )
      )
      (setq entl (subst
                   (cons 13 np13)
                   (assoc 13 entl)
                   entl
                 )
            entl (subst
                   (cons 14 np14)
                   (assoc 14 entl)
                   entl
                 )
      )
      (entmod entl)
    )
  )                                       
  ;;;;;;;
  (setq os (getvar "osmode")
        olderr *error*
        *error* aeoerr
  )
  (setvar "osmode" 0)
  (command "undo" "group")
  (prompt "\nby aeo")
  (prompt "\n不要修改的标注不要选在里面")
  (if (setq ss (ssget '((0 . "DIMENSION"))))
    (progn
      (setq en (entget (ssname ss 0)))
      (if (member '(100 . "AcDbRotatedDimension") en)
        (setq ang (dxf 50 en))
        (setq ang (angle (dxf 13 en) (dxf 14 en)))
      )
    )
  )
  (if (and
        ang
        (setq pt1 (getpoint "\n标注线位置(回车不改):"))
      )
    (progn
      (setq pt2 (polar pt1 ang 1000)
            j 0
            len (sslength ss)
      )
      (while (< j len)
        (setq e (ssname ss j)
              en (entget (ssname ss j))
              pt3 (dxf 10 en)
              pt4 (inters
                    pt1
                    pt2
                    pt3
                    (polar pt3 (+ ang (* 0.5 pi)) 100)
                    nil
                  )
              j (1+ j)
        )
        (command "move" e "" pt3 pt4)
      )
    )
  )
  (if (and
        ang
        (setq pt1 (getpoint "\n引出线位置(回车不改):"))
      )
    (tt pt1 (polar pt1 ang 100) ss)
  )
  (setvar "osmode" os)
  (setq *error* olderr)
  (command "_.undo" "end")
  (princ)
)
(defun ptt (ent)
  (setq obj (vlax-ename->vla-object ent))
  (vla-getboundingbox obj 'p1 'p2)
  (setq p1 (vlax-safearray->list p1)
        p2 (vlax-safearray->list p2))
)

laoliu09

lisp的我有好多，但我要用vba编的！因为我只会vba，我开始是想通过修改标注原点来实现的，但发现尺寸线也跟着有一小段位移，不知道我还漏了什么？所以想请高手提醒一下！

mlr_nj

你把代码发上来，别人才可以明白啊