[LISP函数]：需要尺寸移动的lisp

chenhang · 发表于 2004-7-29 16:36:53

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

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

×

需要尺寸移动的lisp请有的给我一个*-*9

lzy9788 · 发表于 2004-7-29 16:56:50

尺寸移动？用move不是就行了吗

lsjjm · 发表于 2004-7-29 16:59:24

怎么个移动法? 你得把问题的来龙去脉, 具体要求说清楚, 否则怎么回答呀? 随手编一个, 你肯定不满意...

chenhang · 发表于 2004-7-29 17:39:05

最初由 lsjjm 发布
[B]怎么个移动法? 你得把问题的来龙去脉, 具体要求说清楚, 否则怎么回答呀? 随手编一个, 你肯定不满意... [/B]

需要两个lisp，一个用来移动尺寸线，一个用来移动引线，请帮帮我

lsjjm · 发表于 2004-7-30 04:29:13

最初由 chenhang 发布
[B]需要两个lisp，一个用来移动尺寸线，一个用来移动引线，请... [/B]

你还是没说清楚呀!!! 怎么个移动法?
如果单照字面理解, 按2楼说的, move呀! 不用编程.

lijiao · 发表于 2004-7-30 07:33:59

夹点就挺不错。

chenhang · 发表于 2004-7-30 10:31:44

最初由 lsjjm 发布
[B]

你还是没说清楚呀!!! 怎么个移动法?
如果单照字面理解, 按2楼说的, move呀! 不用编程. [/B]

就像这样的lisp

(defun c:dx (/ 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)
)

(defun c:dx (/ 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) 
)

但是我想分开，就是改尺寸线的时候引线不动，改引线的时候尺寸线不动

紫色木头 · 发表于 2004-7-30 12:31:22

不是太明白楼上的意思

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

[LISP函数]：需要尺寸移动的lisp

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

相关帖子