1、简化了绘制内容，不设箭头、不设中间拐点，因为我用不到；
2、增加了比例值的设置，还是因为需求；
3、增加了根据垂足的绘制方式。
;箭头和文字的设置请自行更改程序
(defun c:tt();剖面符号绘制程序
(setq k (getreal "\n输入图纸比例<1.0>:"))
(if (null k) (setq k 1.0))
(setq w (* k 0.5));线宽为0.5的倍数
(setq txt (strcase(getstring "输入剖面符号字母<A>:")))
(if (< (strlen txt) 1) (setq txt "A"))
(setq p0 (getpoint "\n指定第一点:"))
(setq p1 (getpoint p0 "\n指定下一点或[非水平、垂直时剖面轴上的垂足]:"))
(if (and (not (= (cadr p0) (cadr p1)))
(not (= (car p0) (car p1))))
(setq p1 (polar p1 (angle p0 p1) (distance p0 p1))))
(pmfh_draw)
(pmfh_jtfx)
(pmfh_jt)
(prin1)
)
(defun pmfh_draw ();预绘制图形
(redraw)
(grdraw p0 (polar p0 (angle p0 p1) (* 5 k)) 1)
(grdraw p1 (polar p1 (angle p1 p0) (* 5 k)) 1)
)
(defun pmfh_jtfx ();判断箭头方向
(setq go 1)
(while go
(setq grd (grread 1 15 0) gr (car grd) grr (cadr grd))
(setq anga (angle p1 p0)
angb (angle p1 grr)
angc (- anga angb)
angx (angle p0 p1))
(cond ((= gr 5)
(if (or (> angc pi) (and (> angc (- pi)) (< angc 0)))
(progn
(redraw)
(setq py (polar p1 (+ anga (angtof "90")) 5))
(grdraw p1 py 3)
(grdraw py (polar py (- (angle py p1) (angtof "30")) 2) 3)
(grdraw py (polar py (+ (angle py p1) (angtof "30")) 2) 3)
(setq ang1 (- (angle p0 p1) (angtof "90"))
ang2 (- angx (angtof "90")))
)
(progn
(redraw)
(setq py (polar p1 (- anga (angtof "90")) 5))
(grdraw p1 py 3)
(grdraw py (polar py (- (angle py p1) (angtof "30")) 2) 3)
(grdraw py (polar py (+ (angle py p1) (angtof "30")) 2) 3)
(setq ang1 (+ (angle p0 p1) (angtof "90"))
ang2 (+ angx (angtof "90")))
)
)
)
((= gr 3)(setq go nil))
)
)
)
(defun pmfh_jt();绘制箭头
(redraw)
(setq a (* 3.5 k);a 的值设置箭头和文字大小
pl1 (polar p0 ang1 (* a 2))
pl2 (polar p1 ang2 (* a 2)))
(command ".undo" "be");开始记录一个新的撤销单元
(entmake (list '(0 . "LWPOLYLINE");绘制第一个箭头
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 3)
(cons 10 pl1)
(cons 40 w)
(cons 41 w)
(cons 10 p0)
(cons 40 w)
(cons 41 w)
(cons 10 (polar p0 (angle p0 p1) a))
(cons 40 w)
(cons 41 w)))
(entmake (list '(0 . "TEXT");第一个箭头文字
'(62 . 3)
(cons 10 (polar p1 (+ ang2 (angtof "35")) (* a 1.5)))
(cons 40 a)
(cons 1 txt)
'(72 . 1)
'(73 . 2)
(cons 11 (polar p0 (- ang1 (angtof "35")) (* a 1.5)))))
(entmake (list '(0 . "LWPOLYLINE");绘制第二个箭头
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 3)
(cons 10 pl2)
(cons 40 w)
(cons 41 w)
(cons 10 p1)
(cons 40 w)
(cons 41 w)
(cons 10 (polar p1 (angle p1 p0) a))
(cons 40 w)
(cons 41 w)))
(entmake (list '(0 . "TEXT");第二个箭头文字
'(62 . 3)
(cons 10 (polar p1 (+ ang2 (angtof "35")) (* a 1.5)))
(cons 40 a)
(cons 1 txt)
'(72 . 1)
'(73 . 2)
(cons 11 (polar p1 (+ ang2 (angtof "35")) (* a 1.5)))))
(setq n 0)
(command ".undo" "e");结束当前撤销单元的记录
)
专业性太强了，我们这行用不上。
页:
1
[2]