[编程申请]：对齐标注尺寸线起始点，结束点，尺寸界线的位置的程序！

xzk1019 · 发表于 2003-5-3 02:28:36

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

对齐标注尺寸线起始点，结束点，尺寸界线的位置的程序！谢谢！

xzk1019 · 发表于 2003-5-5 01:48:27

建议：简写命令为dj

aeo · 发表于 2003-5-5 22:27:38

来啦

;修改<35%代码,请标明aeo
;有更好的,希望贴出来大家分享
(defun c:trim-dim (/ 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 trim-dim (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引出线位置(回车不改):"))
)
(trim-dim pt1 (polar pt1 ang 100) ss)
)
(setvar "osmode" os)
(setq *error* olderr)
(command "_.undo" "end")
(princ)
)

;修改<35%代码,请标明aeo 
;有更好的,希望贴出来大家分享 
(defun c:trim-dim (/ 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 trim-dim (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引出线位置(回车不改):")) 
      ) 
    (trim-dim pt1 (polar pt1 ang 100) ss) 
  ) 
  (setvar "osmode" os) 
  (setq *error* olderr) 
  (command "_.undo" "end") 
  (princ) 
)

如要简写命令为dj ; 把c:trim-dim改为c:DJ

xzk1019 · 发表于 2003-5-6 20:32:13

非常感谢！非常感谢！非常感谢！

sisi · 发表于 2003-5-16 12:20:49

怎么用?

lcdai · 发表于 2003-5-16 19:06:11

太太太太太好用拉!!

萧山 · 发表于 2003-5-18 20:50:43

可我还是看不懂你的简写，请在简写下把

xiaping · 发表于 2003-5-18 21:16:30

用起来方便，不错。谢谢了。

aeo · 发表于 2003-5-18 21:32:59

最初由萧山发布
[B]可我还是看不懂你的简写，请在简写下把 [/B]

第一行
(defun c:trim-dim ...

trim-dim 改成你要的字母 c:要保留

njshf · 发表于 2003-5-18 23:42:08

很好用，如果再加上些拖拉功能就好了。

xzk1019 · 发表于 2003-10-28 16:31:43

win2000下面好像没有问题，xp里怎么有时候失灵呢？

bing-bing202 · 发表于 2003-10-29 11:38:23

简直就是一流吗！

chenhang1203 · 发表于 2003-10-29 12:54:39

小东工具里有了类似的功能了

lixun · 发表于 2003-11-14 19:13:20

非常实用。谢谢？

coolzhb · 发表于 2003-12-30 17:50:44

挺好用，能不能修改一下程序，不要使用move命令移动到指定，也使用修改其组码值，这样尺寸线的起点位置还保留！

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

[编程申请]：对齐标注尺寸线起始点，结束点，尺寸界线的位置的程序！

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

建议：简写命令为dj.

xp+2cad2002怎么又用不了

浏览过的版块