求简单的快速引线注释

wayne_myles

希望帮忙写一下
要求按顺序
1选箭头第一点
2.指定第二点（拐点）
3，弹出多方文字框（这里要求文字高度是9MM）
4.自己手动输入文字
5.按确定 退出对方框

主要是文字高度是9MM具备啊（其它功能燕秀基本已实现）
谢谢了

baoxiaozhong

MLEADERSTYLE 设定型式与你设定文字型式，二者根本不会冲突，你是在担心什么?

为什么别人给你的建议，不先去试试，就只是认为编程就是比较好。

wayne_myles

坐等高手来看看了！

baoxiaozhong

这个不用写编程吧，自己设定一个 mleaderstyle ，然后用 mleader 就可以达到你的要求。

再偷懒一点，新增一张图纸，做好你要的 mleader，按 CTRL+3 ，叫出工具选项板，把你做好的 mleader拉过去，以后就可以直接点选使用。

wayne_myles

baoxiaozhong 发表于 2015-6-25 05:41
这个不用写编程吧，自己设定一个 mleaderstyle ，然后用 mleader 就可以达到你的要求。

再偷懒一点，新增 ...

谢谢了baoxiaozhong 指点  不好意思我想学习用LSP来解决此问题 呵

wayne_myles

是不是很难弄啊？！！

baoxiaozhong

wayne_myles 發表於 2015-6-26 16:34
是不是很難弄啊？！！

如果你那麼堅持要用編程，那就收個走路工錢。

wayne_myles

baoxiaozhong 发表于 2015-6-27 10:11
如果你那麼堅持要用編程，那就收個走路工錢。

谢谢了 要是在完善下就更好了

wayne_myles

求修改 edata版主 的源码也可以的
只要去掉云线部分就可以了 请多指教
源码如下
------------------------------------------------------------------------------------------------------------------------------------------------------------
;矩形画修订云线-审图版 by edata 2013-12-14
;写这个程序的目的是平时审图的时候需要标记,
;部分来源;http://bbs.mjtd.com/forum.php?mo ... 8694&fromuid=338795,
;部分函数来自明经.
;默认比例100,可以使用时更改.云线图层默认不打印,其余全局变量按需自行更改,
;可以选择绘制矩形,或者拾取多段线.
;文字始终水平方向,具体位置和方向需要指定.
(defun c:xd(/ ss  ANG DS EN EN2 EN3 ENTEXT IN_PT LST LST2 LST3 MPT NTEXTLST P1 P3 PT PT1 PT2 TEXTLST TEXTPT X Y minpoint maxpoint)
  (vl-load-com)
  (defun *error*_New (msg)
  (if *error*_Old (setq *error* *error*_Old))
    (if cmd_old (setvar "cmdecho" cmd_old))
  (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
    (princ )
  )
  (vla-EndUndoMark      
    (vla-get-ActiveDocument (vlax-get-acad-object))
  )  
  (princ)
)
(setq *error*_Old *error*)    ;保存出错处理函数
(setq *error* *error*_New)
(vla-startUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
  ;全局变量设置
  (or xd_scale(setq xd_scale 100));整体比例
  (or xd_cloud(setq xd_cloud 6)) ;云线默认弧长
  (or xd_txth(setq xd_txth 5));云线默认字高
  (or xd_la(setq xd_la "修订云线-edata"));默认云线图层名
  (or xd_col(setq xd_col 1));默认云线图层颜色1
  (or xd_print(setq xd_print 0));默认云线图层不打印
  (or xd_style(setq xd_style "TSSD_Rein"));默认样式名
  (or xd_font(setq xd_font "tssdeng.shx"));默字体名
  (or xd_big_font(setq xd_big_font "hztxt.shx"));默认大字体名
  (initget "b")
  (if (and (if (setq p1(getpoint (strcat"\n指定第一点<B 当前比例"(rtos xd_scale 2 0) ">/<选择对象>:")))(progn
     (if (or (= p1 "b")(= p1 "B"))(progn(setq xd_scale(getint (strcat"\n请输入比例<当前"(rtos xd_scale 2 0) ">:"))) (c:xd)(exit))(setq p3(getcorner p1 "\n指定对角点:")))
     )(progn
        (princ "\n请选择多段线:")
       (setq ss(ssget ":E:S" '((0 . "LWPOLYLINE"))))
       )
       ))   
    (progn      
      (if (=(tblobjname "LAYER" xd_la) nil)
        (entmake (list '(0 . "LAYER")
         '(100 . "AcDbSymbolTableRecord")
         '(100 . "AcDbLayerTableRecord")
         '(70 . 0)
         '(6 . "Continuous")
   (cons 2 xd_la)
         (cons 62 xd_col)
         (cons 290 xd_print)
    )
  ))
      (if (=(tblobjname "STYLE" xd_style) nil)
        (progn
        (entmake (list '(0 . "STYLE")
                       '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbTextStyleTableRecord")
                       (cons 2  xd_style)
                       '(70 . 0)
                       '(40 . 0)
                       '(41 . 0)
                       (cons 3  xd_font)
                       (cons 4  xd_big_font)))))
(defun 2pt4pt(p1 p3 / p2 p4 pts )
      (setq pts(vl-sort (list p1 p3)
             (function (lambda (e1 e2)
                         (and (< (car e1) (car e2))(< (cadr e1) (cadr e2)) ) ) )))
      (setq p1(car pts)
      p3(cadr pts))
      (setq p2(list (car p3)(cadr p1))
      p4(list (car p1)(cadr p3))      
      )
      (list p1 p2 p3 p4)
  )
      (if ss (progn
         (princ "\n选择模式:")
         (setq lst(vertexs (ssname ss 0)))
         (entdel (ssname ss 0))
         )
  (setq lst (2pt4pt p1 p3)))
      
      (setq en(entmakex (append
        (list '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        (cons 8 xd_la)
        (cons 90 (length lst))
        (cons 70 1)        
        )
      (mapcar '(lambda (pt)(cons 10 pt)) lst ))))
      (if (>= (vla-get-length (vlax-ename->vla-object en)) (* 12 xd_scale))
  (progn
    (setq cmd_old(getvar "cmdecho"))
    (setvar "cmdecho" 0)
      (vl-cmdf "_revcloud" "a" (* xd_cloud xd_scale) "" "s" "c" "o" "" en "N")
    (if cmd_old (setvar "cmdecho" cmd_old))
      )
  (princ "\n矩形太小,无法生成修订云线!"))
      (setq en (entlast))
        (vla-getboundingbox (vlax-ename->vla-object en) 'minpoint 'maxpoint)
  (setq p1 (vlax-safearray->list maxpoint)
        p3 (vlax-safearray->list minpoint))
      (setq mpt(mapcar '(lambda(x y)(/ (+ x y) 2.)) p1 p3))
      
      (entmod (subst(cons 8 xd_la)(assoc 8 (entget en))(entget en)))
      
      (if (and (setq pt1(getpoint mpt "\n指定引线点:"))
         (/= (ISPTINPM pt1 lst) t)
         )
  (progn
      (setq en2(entmakex(list (cons 0 "line")(cons 8 xd_la) (cons 10 mpt)(cons 11 pt1))))      
      (setq in_pt(vlax-safearray->list(vlax-variant-value(vla-IntersectWith
                 (vlax-ename->vla-object en)     
  (vlax-ename->vla-object en2) acExtendNoNe))))
(if in_pt (entmod (subst(cons 10 in_pt)(assoc 10 (entget en2))(entget en2))))
      
   
      (if (setq pt2 (getpoint pt1"\n指定文字方向:"))
  (progn
      (setq ang (angle pt1 (list(car pt2)(cadr pt1))))
      (if en2(entdel en2))
      (setq lst2(list in_pt pt1 (list(car pt2)(cadr pt1))))
      (setq en3(entmakex (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")(cons 8 xd_la)  (cons 90 (length lst2)))
      (mapcar '(lambda (pt)(cons 10 pt)) lst2 ))  ))
      
      (setq entext(entmakex (list '(0 . "TEXT")
         (cons 1 "输入文字")
         (cons 10 (polar pt1 (* pi 0.5) (* 0.625 xd_scale)))
         (cons 7 xd_style)
         (cons 8 xd_la)
         (cons 41 0.7)
         (cons 40 (* xd_txth xd_scale))
          (cons 73 0)
          (cons 72 (cond((> (car pt1) (car pt2))2)(t 0)))            
         (cons 11 (polar pt1 (* pi 0.5) (* 0.625 xd_scale)))
          )))
      (vl-cmdf "_ddedit" entext  "" )
      (setq textlst(textbox (entget entext)))
      (setq ntextlst(2pt4pt (car textlst)(cadr textlst)))
      (setq ds(distance (car ntextlst)(cadr ntextlst)))
      (setq textpt(polar pt1 ang ds))
      (setq lst3(list in_pt pt1 textpt))
      (if en3(entdel en3))
      (entmake (append(list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")(cons 8 xd_la)  (cons 90 (length lst3)))
      (mapcar '(lambda (pt)(cons 10 pt)) lst3 ))
  ))(progn(if en2(entdel en2)) (princ "\n未指定文字方向!"))))(princ "\n未指定引线!"))
      );end_progn
    (princ"\n Nothing!")
    )
  (vla-EndUndoMark      
    (vla-get-ActiveDocument (vlax-get-acad-object))
  )
  (if *error*_Old (setq *error* *error*_Old))
  (gc)
  
  (princ)
  
  )
(defun ISPTINPM (XPT POINTS / x y )
(equal pi(abs(apply '+(mapcar'(lambda (X Y)(rem (- (angle XPT X) (angle XPT Y)) pi))
                               (reverse (cdr (reverse (cons (last POINTS) POINTS))))
                          POINTS
                       )
               )
          )
         1e-6
  ) ;end_equal
)
;;返回多段线顶点表
(defun vertexs (ename / plist pp n)        
  (setq obj (vlax-ename->vla-object ename))
  (setq plist (vlax-safearray->list
  (vlax-variant-value
    (vla-get-coordinates obj))))
  (setq n 0)
  (repeat (/ (length plist) 2)
    (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))
    (setq n (+ n 2))
  )
  pp
)
(prompt "\n矩形修定云线带引线文字by edata@2013.12.14! 命令 xd")
(princ)

wayne_myles

自己搞了半天 献丑了

(defun c:yy ()
(command  "style" "Standard" "宋体" "9" "0.7" "0" "n" "n"  )
(command   "DIMTXSTY"   "STANDARD"
                       "DIMTXT"   "8.0")


(c:yx_q)  ；；调用的燕秀外挂快速引线注释
(princ)
)


基本达到自己要求，求高手指点改进