求高手帮我写这样一个程序,论坛没有找到
如图所述的功能,谢谢各位高手,下面是测试图 本帖最后由 langjs 于 2012-12-4 21:26 编辑这个简单
(defun C:aa (/ ent h l pt pt1 pt10 pt11 pt2 r ss)
(setq ss (ssget ":E:S" '((0 . "line")))
ent (entget (ssname ss 0))
pt10 (cdr (assoc 10 ent))
pt11 (cdr (assoc 11 ent))
L (* 0.1 (distance pt10 pt11))
pt (getpoint "\n指定插入点:")
h (getvar "DIMTXT")
)
(if (< (car pt10) (car pt11))
(setq r (angle pt10 pt11))
(setq r (angle pt11 pt10))
)
(entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 (setq pt1 (polar pt r l)))))
(entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 (setq pt2 (list (car pt1) (cadr pt))))))
(entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
(entmake (list '(0 . "TEXT") (cons 10 (setq pt10 (polar (polar pt r (* 0.5 l)) (+ r (* 0.5 pi)) (* 0.3 h)))) (cons 40 h)
(cons 1 (rtos (* 10 L) 2 2)) (cons 50 r) '(41 . 0.8) '(72 . 1) (cons 11 pt10) '(73 . 0)
)
)
(entmake (list '(0 . "TEXT") (cons 10 (setq pt10 (list (+ (car pt1) (* 1.3 h)) (* 0.5 (+ (cadr pt1) (cadr pt2))))))
(cons 40 h) (cons 1 (rtos (* 10 (distance pt1 pt2)) 2 2)) (cons 50 (* 0.5 pi)) '(41 . 0.8) '(72 . 1)
(cons 11 pt10) '(73 . 0)
)
)
(entmake (list '(0 . "TEXT") (cons 10 (setq pt10 (list (* 0.5 (+ (car pt) (car pt2))) (- (cadr pt) (* 1.3 h)))))
(cons 40 h) (cons 1 (rtos (* 10 (distance pt pt2)) 2 2)) '(41 . 0.8) '(72 . 1) (cons 11 pt10) '(73 . 0)
)
)
(princ)
)
三角函数计算问题 不用三角函数不行吗?三个标注,然后在提取标注文字,可以不?菜鸟不懂 楼上赞一个!… langjs 发表于 2012-12-4 21:18 static/image/common/back.gif
这个简单
(defun C:aa (/ ent h l pt pt1 pt10 pt11 pt2 r ss)
程序基本满足要求,还有两个问题,一是单位能不能精确到零,二是换一个方向出了点小问题,斜边在下,我想斜边在上,大侠能不能完善一下? 稍微改一下就行了 不会改啊 上赞一个!… 不错,高手整的快啊
页:
[1]
2