引线---麻烦朋友帮小修改一下，
这是论坛上一个朋友帮忙写的，，可惜已联系不上他。麻烦朋友们帮忙改下----我想要引线的第二点到第三点始终水平，不知道能不能做到 ，谢谢(defun c:lee (/ ent txt pt1 pt1x pt1y pt2 pt2x pt2y pt3 pt3x pt3y yxfx)
(setvar "cmdecho" 0)
(command "_undo" "_be")
(setq zigao 2.25);设置字高
(setq zitiyangshi "ROMANS");设置字体样式名称
(setq ziti "hzasc,hztxt");设置字体
(if (= (tblsearch "style" zitiyangshi) nil) ; 判断是否存在HZ字体样式
(command "style" zitiyangshi ziti "0" "0.7" "0.0" "" "" ""); 新建HZ字体样式
)
(if (= (tblsearch "layer" "dim") nil) ; 判断是否存在dim图层
(command "layer" "N" "dim" "C" 1 "dim" ""); 新建dim层
)
(if (= (tblsearch "layer" "TXT7") nil) ; 判断是否存在TXT7图层
(command "layer" "N" "TXT7" "C" 7 "TXT7" ""); 新建TXT7层
)
(yinxian)
(setq ent (entlast))
(if (> pt2x pt3x)
(setq yxfx "HL")
(setq yxfx "HR")
)
(setq txt (cdr (assoc 1 (entget (car (entsel "选择已有文字"))))))
(cond ((= yxfx "HL");;条件1：引线方向水平向左
(entmake (list '(0 . "text") '(8 . "TXT7") '(10 0.0 0.0 0.0)
(list 11 (- pt3x (getvar "dimscale")) pt2y 0.0)
(cons 7 zitiyangshi) (cons 40 (* zigao (getvar "dimscale"))) '(41 . 0.7) (cons 1 txt)
'(72 . 2) '(73 . 2) ))
)
((= yxfx "HR");;条件1：引线方向水平向右
(entmake (list '(0 . "text") '(8 . "TXT7") '(10 0.0 0.0 0.0)
(list 11 (+ pt3x (getvar "dimscale")) pt2y 0.0)
(cons 7 zitiyangshi) (cons 40 (* zigao (getvar "dimscale"))) '(41 . 0.7) (cons 1 txt)
'(72 . 0) '(73 . 2) ))
)
);end cond
(command "_undo" "_e")
(princ "\n ok")
(princ)
);end main
(defun yinxian()
(setq pt1 (getpoint "\n选择引线第一点"))
(setq pt1x (car pt1)
pt1y (cadr pt1)
)
(setq pt2 (getpoint pt1 "\n选择引线第二点"))
(setq pt2x (car pt2)
pt2y (cadr pt2)
)
(setq pt3 (getpoint pt2 "\n选择引线第三点"))
(setq pt3x (car pt3)
pt3y (cadr pt3)
)
(entmake (list '(0 . "LEADER") (cons 100 "AcDbEntity") (cons 8 "dim")
(cons 100 "AcDbLeader")
(cons 3 (rtos (getvar "dimscale"))) '(71 . 1)
'(73 . 3) '(74 . 1)'(76 . 3)
(list 10 pt1x pt1y 0.0)
(list 10 pt2x pt2y 0.0)
(list 10 pt3x pt2y 0.0)
)
);end entmake
);end defun yinxian
没人帮顶啊，，我愿意付费，，朋友们棒棒忙
页:
[1]