bbdbbd 发表于 2013-6-16 13:28:09

求帮忙编一个lisp

    单位里面要求梁截面标时下面加箭头，表示界面所示方向，求哪位大神能帮我编个在选定文字下部画半箭头的lisp，谢了，


gavvy 发表于 2013-6-16 13:36:13

10块钱帮你写个

Andyhon 发表于 2013-6-16 13:59:54

http://bbs.mjtd.com/thread-100603-1-1.html
Ref: 4. ....

cable2004 发表于 2013-6-16 14:38:47

(defun C:QQ ( / a1 a2 a3 ang1 box1 c1 en k1 p p0 p1 )
(vl-load-com)
(SETQ   EN(entget (car (entsel "/n选择文字")))
          p0 (cdr (assoc 10 en))
        ang1 (cdr (assoc 50 en))
      box1 (textbox en)
        c1   (caadr box1)
      k1   (cadadr box1)
        P1   (polar p0 (+ ang1 (* 1.5 PI)) (* 0.2 k1))
        )
(setq p (getpoint "/n箭头方向 "))
(if(< (car p) (car p0))
(SETQ   a1(polar p1 ang1 (* -1 k1))
          a2(polar p1 ang1 (* -0.1 k1))
          a3(polar p1 ang1 (* 2 k1))
          )
(SETQ   a1(polar p1 ang1 (+ c1 k1))
          a2(polar p1 ang1 (+ c1 (* 0.1 k1)))
          a3(polar p1 ang1 (- c1 k1 k1))
          )
)
(entmakex (list (cons 0 "LWPOLYLINE")
                           (cons 100 "AcDbEntity")
                           (cons 100 "AcDbPolyline")
                           (cons 90 4)
                           (cons 70 1)
                           (cons 10 a1)
                           (cons 40 1)
                           (cons 41 (* 0.25 k1))
                           (cons 10 a2)
                           (cons 10 a3)
                     ))
(PRINC)
)

bbdbbd 发表于 2013-6-16 14:40:03

cable2004 发表于 2013-6-16 14:38 static/image/common/back.gif
(defun C:QQ ( / a1 a2 a3 ang1 box1 c1 en k1 p p0 p1 )
(vl-load-com)
(SETQ   EN(entget (car ( ...

谢谢大神，太感谢了。

bbdbbd 发表于 2013-6-16 14:46:22

这个是整箭头，要是能画个半箭头就完美了，嘿嘿

gavvy 发表于 2013-6-19 10:26:21

都说10块钱了嘛给群里加点钱

luojunmax 发表于 2015-9-1 23:02:15

谢谢CABLE2004
页: [1]
查看完整版本: 求帮忙编一个lisp