求简单的快速引线注释
本帖最后由 wayne_myles 于 2015-6-23 15:16 编辑希望帮忙写一下
要求按顺序
1选箭头第一点
2.指定第二点（拐点）
3，弹出多方文字框（这里要求文字高度是9MM）
4.自己手动输入文字
5.按确定 退出对方框
主要是文字高度是9MM具备啊（其它功能燕秀基本已实现）
谢谢了 MLEADERSTYLE 设定型式与你设定文字型式，二者根本不会冲突，你是在担心什么?
为什么别人给你的建议，不先去试试，就只是认为编程就是比较好。 坐等高手来看看了！ 这个不用写编程吧，自己设定一个 mleaderstyle ，然后用 mleader 就可以达到你的要求。
再偷懒一点，新增一张图纸，做好你要的 mleader，按 CTRL+3 ，叫出工具选项板，把你做好的 mleader拉过去，以后就可以直接点选使用。 本帖最后由 wayne_myles 于 2015-6-26 08:40 编辑
baoxiaozhong 发表于 2015-6-25 05:41 static/image/common/back.gif
这个不用写编程吧，自己设定一个 mleaderstyle ，然后用 mleader 就可以达到你的要求。
再偷懒一点，新增 ...
谢谢了baoxiaozhong 指点不好意思我想学习用LSP来解决此问题 呵 是不是很难弄啊？！！ wayne_myles 發表於 2015-6-26 16:34 static/image/common/back.gif
是不是很難弄啊？！！
如果你那麼堅持要用編程，那就收個走路工錢。
baoxiaozhong 发表于 2015-6-27 10:11 static/image/common/back.gif
如果你那麼堅持要用編程，那就收個走路工錢。
谢谢了 要是在完善下就更好了 本帖最后由 wayne_myles 于 2015-6-30 09:20 编辑
求修改 edata版主 的源码也可以的
只要去掉云线部分就可以了 请多指教
源码如下
------------------------------------------------------------------------------------------------------------------------------------------------------------
;矩形画修订云线-审图版 by edata 2013-12-14
;写这个程序的目的是平时审图的时候需要标记,
;部分来源;http://bbs.mjtd.com/forum.php?mo ... 8694&fromuid=338795,
;部分函数来自明经.
;默认比例100,可以使用时更改.云线图层默认不打印,其余全局变量按需自行更改,
;可以选择绘制矩形,或者拾取多段线.
;文字始终水平方向,具体位置和方向需要指定.
(defun c:xd(/ ssANG 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 2xd_style)
'(70 . 0)
'(40 . 0)
'(41 . 0)
(cons 3xd_font)
(cons 4xd_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)
自己搞了半天 献丑了
(defun c:yy ()
(command"style" "Standard" "宋体" "9" "0.7" "0" "n" "n")
(command "DIMTXSTY" "STANDARD"
"DIMTXT" "8.0")
(c:yx_q)；；调用的燕秀外挂快速引线注释
(princ)
)
基本达到自己要求，求高手指点改进
页:
[1]
2