动态插入箭头

adolfken

平常因为工作的关系经常要插入一些箭头,根据鼠标的位置变化方向和变化.之前有人写过这个功能,我就按照样例仿写了一下,可能因为水平的关系算法有些复杂,还希望大家轻拍,麻烦各位大侠帮忙把算法优化一下,刚写完没有完全测试可能有点小问题.
[pcode=lisp,true](defun c:tt ()
   (vl-load-com)
   (setq acad (vlax-get-acad-object))
   (setq acaddocument (vla-get-activedocument acad))
   (setq mspace (vla-get-modelspace acaddocument))
   (setq h (getreal "\n请输入偏移距离"))
(setq endata (entsel "\n请选择一条线"))
   (setq ename (car endata))
   (setq p0 (cadr endata))
   (setq obj (vlax-ename->vla-object ename))
   (setq l1 (car (vlax-safearray->list (vlax-variant-value (vla-offset obj h)))))           ;;偏移曲线1
   (setq l2 (car (vlax-safearray->list (vlax-variant-value (vla-offset obj (* -1 h))))))    ;;偏移曲线2
   (setq p1 (vlax-curve-getclosestpointto l1 p0 t))      ;;插入点1
   (setq p2 (vlax-curve-getclosestpointto l2 p0 t))      ;;插入点2
   (vla-delete l1)    ;;删除曲线1
   (vla-delete l2)    ;;删除曲线2
   (setq ang1 (angle p2 p1))  ;;插入点1 点2角度
   (setq ang2 (- ang1 (/ pi 2)))  ;;计算直线角度或者曲线的切线角度
   (setq obj (vla-insertblock mspace (vlax-3d-point p2) "11005" 1 1 1 ang2)) ;;插入块名为11005的图块
   (setq loop t)
  (while loop
    (setq code (grread t 8))
    (cond
     ((= (car code) 5)
    (setq ang3 (- (angle p0 (cadr code)) ang2))     ;;光标所在点与单选点的角度减去直线的或者曲线切线的角度
    (if (< ang3 0)
        (setq ang3 (+ ang3 (* 2 pi))))
     (cond
        ((and (> ang3 0 ) (< ang3  (/ pi 2)))  
         (vla-put-Rotation obj ang2)  
         (vla-put-insertionpoint obj (vlax-3d-point p1))
         )
        ((and (> ang3 (/ pi 2)) (< ang3 pi))
         (vla-put-Rotation obj (- ang2 pi))
         (vla-put-insertionpoint obj (vlax-3d-point p1))
         )
        ((and (> ang3 pi) (< ang3  (* 3 (/ pi 2))))
         (vla-put-Rotation obj (- ang2 pi))
         (vla-put-insertionpoint obj (vlax-3d-point p2))
         )
        ((and (> ang3 (* 3 (/ pi 2))) (< ang3  (* 2 pi)))
         (vla-put-Rotation obj ang2)
         (vla-put-insertionpoint obj (vlax-3d-point p2))
         )            
       )
    )
   ((= code '(25 37)) (vla-delete obj))
   (T (setq loop nil))
   )
   )
  )[/pcode]

wowan1314

不错。支持个。
能实现功能。没BUG就可以了。其他没必要优化了。 耗时间的程序才需要优化呢。

SmartStar

过瘾过瘾，正好可以用来标注水流方向什么的。

SmartStar

这是怎么回事？

adolfken

SmartStar 发表于 2013-4-15 12:12

                               
登录/注册后可看大图

这是怎么回事？

命令没有加载吧  这里的图块名称是11105  需要自己制作一个箭头得块

仲文玉

:lol哈哈，测试下

adolfken

wowan1314 发表于 2013-4-15 11:25

                               
登录/注册后可看大图

不错。支持个。
能实现功能。没BUG就可以了。其他没必要优化了。 耗时间的程序才需要优化呢。

我的算法比较麻烦 通过偏移找到两边的插入点,一只在想有没有更简单的方法.还请大侠赐教

wowan1314

adolfken 发表于 2013-4-15 12:23

                               
登录/注册后可看大图

我的算法比较麻烦 通过偏移找到两边的插入点,一只在想有没有更简单的方法.还请大侠赐教

没什么麻烦的！不偏移也得通过角度、距离求出来，代码比你的还长。

得到PT点选处曲线的角度A1，再算出A1垂直的角度A2，然后求出距PT点A2角度H距离处的点即为插入点。

另外我也初学，大家共同进步吧。我一般程序出来了就不管算法啦。除非是耗时间的程序就多考虑会。

adolfken

在院长和wowan两位大侠的帮助下,我把代码按照正规的算法又重新写了一遍,在这里要感谢两位大侠.
[pcode=lisp,true]
(defun c:tt ()
          (vl-load-com)
          (setq acad (vlax-get-acad-object))
          (setq acaddocument (vla-get-activedocument acad))
          (setq mspace (vla-get-modelspace acaddocument))
          (setq h (getreal "\n请输入偏移距离"))
        (setq endata (entsel "\n请选择一条线"))
          (setq p0 (cadr endata))
        (setq l1 (vlax-ename->vla-object (car endata)))
          (setq p1 (vlax-curve-getclosestpointto l1 p0 t))
          (setq ang1 (angle p1 (mapcar '+ p1 (vlax-curve-getfirstderiv l1 (vlax-curve-getparamatpoint l1 p1)))))
        (setq p2 (polar p1 (+ ang1 (/ pi 2)) h))
          (setq p3 (polar p1 (- ang1 (/ pi 2)) h))
          (setq obj (vla-insertblock mspace (vlax-3d-point p2) "11005" 1 1 1 ang1))
          (setq loop t)
         (while loop
                  (setq code (grread t 8))
                  (cond
                          ((= (car code) 5)
                         (setq ang2 (- (angle p1 (cadr code)) ang1))  
                         (if (< ang2 0)
                             (setq ang2 (+ ang2 (* 2 pi))))
                          (cond
                             ((and (> ang2 0 ) (< ang2 (/ pi 2)))               
                              (vla-put-Rotation obj ang1)               
                              (vla-put-insertionpoint obj (vlax-3d-point p2))
                              )
                             ((and (> ang2 (/ pi 2) ) (< ang2 pi))               
                              (vla-put-Rotation obj (- ang1 pi))               
                              (vla-put-insertionpoint obj (vlax-3d-point p2))
                              )
                             ((and (> ang2 pi ) (< ang2  (* 3 (/ pi 2))))               
                              (vla-put-Rotation obj (- ang1 pi))               
                              (vla-put-insertionpoint obj (vlax-3d-point p3))
                              )
                             ((and (> ang2 (* 3 (/ pi 2))) (< ang2  (* pi 2)))               
                              (vla-put-Rotation obj ang1)               
                              (vla-put-insertionpoint obj (vlax-3d-point p3))
                              )
                            )
                         )
                        ((= (car code) 25) (setq loop nil) (vla-delete obj))
                        (T (setq loop nil))
                        )
          )
  )[/pcode]

XDSoft

adolfken 发表于 2013-4-15 12:16

                               
登录/注册后可看大图

命令没有加载吧  这里的图块名称是11105  需要自己制作一个箭头得块

建议在程序里面自动做箭头块。

605052747

haohaohaohao

ptime

不错，顶顶！！

/db_自贡黄明儒_

我是用qleader来画箭头的.

adolfken

/db_自贡黄明儒_ 发表于 2013-5-9 14:54

                               
登录/注册后可看大图

我是用qleader来画箭头的.

工作关系 各种箭头非常多 而且都有标准 所以图省事基本都是做的图块

sicky111

非常好的程式。