[求助]找高手帮忙写个LISP小程序

nonsmall

(defun c:j (/ v_cmd)
  (setq v_cmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (go)
  (setvar "cmdecho" v_cmd)
)
(defun go ( / a b on1 on2 enta entb temp pt1 pt2 pt3 pt4 ang1 ang2 v_pic
     pta ptb)
  (setq on1 t)
  (setq on2 t)
  (while on1
    (if (setq
   a
    (car
      (entsel (print "选取一个图块)"))
    )
 )
      (progn
 (print "---->")
 (print "------->")
 (print "---------->")
 (while on2
   (if
     (setq b
     (car
       (entsel
         (print "选取直线")
       )
     )
     )
      (if (not (equal a b))
        (setq on2 nil)
      )
   )
 )
 (setq on1 nil)
      )
    )
  )
  (setq enta (entget a))
  (setq entb (entget b))
  (entmake enta)
  (setq temp (entlast))
  (command "explode" temp "")
  (setq temp (entlast))
  (setq pt1 (cdr (assoc 10 (entget temp))))
  (setq pt2 (cdr (assoc 11 (entget temp))))
  (setq pt3 (cdr (assoc 10 entb)))
  (setq pt4 (cdr (assoc 11 entb)))
  (setq pta (list (/ (+ (car pt1) (car pt2)) 2)
    (/ (+ (cadr pt1) (cadr pt2)) 2)
    (/ (+ (last pt1) (last pt2)) 2)
     )
  )
  (setq ang1 (angle pt1 pt2))
  (setq ang2 (angle pt3 pt4))
  (entdel (entlast))
  (setq v_pic (getvar "pickstyle"))
  (setvar "pickstyle" 0)
  (setq ptb (getpoint "选择打断点"))
  (setvar "pickstyle" v_pic)
  (command "break" b ptb "@" "")
  (command "move" a "" pta ptb)
  (command "rotate"
    a
    ""
    ptb
    (angtos (- ang2 (/ pi 2) ang1))
    ""
  )
  (go)
)

nonsmall

你把捕捉打开再用

carrot1983

9楼的，不好用。把块给炸了

nonsmall

楼上的你看仔细了，我炸的是(entmake)之后的(entlast),就是重新复制了一个后才炸开的，原来的那个根本没碰！

carrot1983

http://acad.net.cn/viewthread.php?tid=247&extra=page%3D1

我也写了一个，效果还不错。要不试试！

nonsmall

你写的第一个我测了一下，为什么变平行了？

blade2002

没想到一会儿就有了3个程序，试了一下都达到了我的目的，真棒！

再次感谢大家的关注，感谢ZZXXQQ，nonsmall，carrot1983的帮忙

程序我收藏了

blade2002

nonsmall发表于2007-7-20 16:17:00你写的第一个我测了一下，为什么变平行了？

carrot1983写的那个图块要水平放置的

carrot1983

支持楼上。。。呵呵

nonsmall

我倒，一楼的图块好像是垂直的吧，呵呵，不过楼上都是强人啊