caoyin 发表于 2009-1-22 18:06:00

网友*无形*拜托编写的程序

本帖最后由 作者 于 2009-2-7 10:20:55 编辑

;;相关函数链接
;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=72404
;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=59013&replyID=&skin=1
(defun C:MEN1 (/ ANGREST EN1 PT1 EDAT PTS PTE ANG EN2 PT2 MIR PT1@ PT2@ MPT)
   (LT:ERROR-INIT (list '("cmdecho" 0 "osmode" 0) 0 nil))
   (defun ANGREST (ang) (angle '(0 0) (polar '(0 0) ang 1)))
   (or (setq EN1 (LT:ENTSEL "\n选择直线: "
                            '((0 . "line"))
                            '("对象必须是直线。")
               )
       )
       (exit)
   )
   (mapcar 'set '(EN1 PT1) EN1)
   (setq PT1(vlax-curve-getClosestPointTo EN1 PT1)
         EDAT (entget EN1)
         PTS(cdr (assoc 10 EDAT))
         PTE(cdr (assoc 11 EDAT))
         ANG(angle PTS PTE)
         EN2(ssget "_F"
                     (list (polar PT1 (+ ANG (/ PI 2)) 300)
                           (polar PT1 (- ANG (/ PI 2)) 300)
                     )
                  '((0 . "line"))
            )
         EN2(car (ssnamex (ssdel EN1 EN2)))
         PT2(cadr (last EN2))
         EN2(cadr EN2)
         PT2(vlax-curve-getClosestPointTo EN2 PT2)
         AN2(angle PT2 PT1)
   )
   (if (> (distance PT1 PTS) (distance PT1 PTE))
   (setq ANG (angle PTE PTS))
   )
   (setq AN@ (+ ANG (/ PI 2)))
   (if (equal AN@ (* PI 2) 0.000001)
   (setq AN@ 0)
   )
   (setq AN@ (ANGREST AN@))
   (if (equal AN@ AN2 0.000001)
   (setq MIR 1)
   (setq MIR -1)
   )
   (setq PT1@ (polar PT1 ANG 900)
         PT2@ (polar PT2 ANG 900)
         MPT(mapcar '(lambda (X Y) (/ (+ X Y) 2.)) PT1 PT2)
   )
   (command "_.line" PT1 PT2 "")
   (command "_.line" PT1@ PT2@ "")
   (command "_.break" (list EN1 PT1) PT1@)
   (command "_.break" (list EN2 PT2) PT2@)
   (if (or (tblobjname "BLOCK" "M1")
         (findfile "M1.dwg")
       )
   (command "_.insert" "m1" MPT "" MIR (/ (* ANG 180) pi))
   (alert "\n未发现块 M1 。")
   )
   (LT:ERROR_RESTORE)
)
图块M1.dwg

lljj 发表于 2009-1-22 18:22:00

非常感谢谢caoyin版主指点和帮助!

lljj 发表于 2009-1-23 11:33:00

<p>存在以下问题：</p><p>1。加入出错处理时无法执行</p><p>2。当&nbsp;&nbsp;&nbsp; 直线角度大于或等于270度且小于360度时，两条线上插入的块是同一方向的.</p>

jxphklibin 发表于 2009-1-23 14:17:00

改程序实现何种功能？

lljj 发表于 2009-1-23 15:04:00

<p>插入一个图块</p><p></p>

caoyin 发表于 2009-2-2 09:11:00

lljj发表于2009-1-23 11:33:00static/image/common/back.gif存在以下问题：1。加入出错处理时无法执行2。当&nbsp;&nbsp;&nbsp; 直线角度大于或等于270度且小于360度时，两条线上插入的块是同一方向的.

<p></p>这个我发现了，我看看再回你

jxphklibin 发表于 2009-2-3 16:52:00

没有函数 lt:entsel ，贴上！

caoyin 发表于 2009-2-7 10:22:00

2楼代码已经修正
页: [1]
查看完整版本: 网友*无形*拜托编写的程序