yang686526

大菜鸟的程序，标注角度，还不能用，高手帮忙改一下！
www.dimcax.com
大菜鸟的程序，标注角度，还不能用，高手帮忙改一下！
(defun c:bz(/ p1 p2 p3 p4 p5 p6 p7 p8 ang ang1 ang2 p58_mid p68_mid m68x m68y m58x m58y l2 l3)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setq p1 (getpoint "\n中心点:"))
(setq p2 (getpoint "\n第一点:"));第一点为主方向上的点
(setq p3 (getpoint "\n第二点:"));第二点为次方向上的端点
(setvar "osmode" 0)
(setq p4 (polar p3 (angle p1 p3) 5))
(setq p5 (polar p3 (angle p1 p3) 35))
(setq p6 (polar p3 (angle p1 p3) 23))
(command "line" p4 p5 "")
(command "line" p5 "per" p2 "")
(setq en1 (entlast))
(command "line" p6 "per" p5 "")
(setq en2 (entlast))
(setq en1data (entget en1))
(setq pt11 (cdr (assoc 11 en1data)))
(setq p7 pt11)
(command "trim" en2 "" (list en1 p7) "")
(setq en2data (entget en2))
(setq pt211 (cdr (assoc 11 en2data)))
(setq p8 pt211)
(setq l3 (distance p5 p8) l2 (distance p6 p8))
(if (> l2 l3)
(setq l2text "1000" l3text (itoa (fix (/ l3 l2 0.001))))
(setq l3text "1000" l2text (itoa (fix (/ l2 l3 0.001))))
)
(setq ang (angle p1 p3) ang1 (angle p6 p8) ang2 (angle p8 p5))
(setq m68x (/ (+ (car p6)(car p8)) 2))
(setq m68y (/ (+ (cadr p6)(cadr p8)) 2))
(setq p68_mid (list m68x m68y))
(setq m58x (/ (+ (car p5)(car p8)) 2))
(setq m58y (/ (+ (cadr p5)(cadr p8)) 2))
(setq p58_mid (list m58x m58y))
(cond
((and (< ang (/ pi 2.0))(> ang 0)) (if (> l2 l3)
(progn
(command "text" "j" "bc" (polar p68_mid (+ ang1 (/ pi 2.0)) 1) 2.5 90 l2text "")
(command "text" "j" "bc" (polar p58_mid (+ ang2 (/ pi 2.0)) 1) 2.5 0 l3text "")
);progn
(progn
(command "text" "j" "bc" (polar p68_mid (+ ang1 (/ pi 2.0)) 1) 2.5 90 l2text "")
(command "text" "j" "bc" (polar p58_mid (+ ang2 (/ pi 2.0)) 1) 2.5 0 l3text "")
);progn
);if
)
((and (< ang pi)(> ang (/ pi 2.0))) (if (> l2 l3)
(progn
(command "text" "j" "tc" (polar p68_mid 0 1) 2.5 90 l2text "")
(command "text" "j" "bc" (polar p58_mid (+ ang2 (/ pi 2.0)) -1) 2.5 0 l3text "")
);progn
(progn
(command "text" "j" "tc" (polar p68_mid 0 1) 2.5 90 l2text "")
(command "text" "j" "bc" (polar p58_mid (+ ang2 (/ pi 2.0)) -1) 2.5 0 l3text "")
);progn
);if
)
((and (< ang (* pi 1.5))(> ang pi)) (if (> l2 l3)
(progn
(command "text" "j" "tc" (polar p68_mid 0 1) 2.5 0 l2text "")
(command "text" "j" "tc" (polar p58_mid (+ ang2 (/ pi 2.0)) 1) 2.5 90 l3text "")
);progn
(progn
(command "text" "j" "tc" (polar p68_mid 0 1) 2.5 0 l2text "")
(command "text" "j" "tc" (polar p58_mid (+ ang2 (/ pi 2.0)) 1) 2.5 90 l3text "")
);progn
);if
)
((and (< ang (* pi 2.0))(> ang (* 1.5 pi))) (if (> l2 l3)
(progn
(command "text" "j" "bc" (polar p68_mid (+ ang1 (/ pi 2.0)) -1) 2.5 0 l2text "")
(command "text" "j" "tc" (polar p58_mid (+ ang2 (/ pi 2.0)) -1) 2.5 90 l3text "")
);progn
(progn
(command "text" "j" "bc" (polar p68_mid (+ ang1 (/ pi 2.0)) -1) 2.5 0 l2text "")
(command "text" "j" "tc" (polar p58_mid (+ ang2 (/ pi 2.0)) -1) 2.5 90s l3text "")
);progn
);if
)
(t (alert "不能标0度和90度角") (quit))

)
(setvar "osmode" os)
(setvar "cmdecho" 1)
(prin1)
)
选择了就不要放弃！

图片：

问题太多了，首先是：
1、标注的文字根据我写的程序 ，不能在合适的位置上
2、没有添加比例因子，所以只能用在1：1的图上
3、局部变量不知道怎么才是对的，干脆全写上了
4、还差图层没有仔细定义
5、应该用子程序的还用不好
6、程序思路不清楚
学了一阵子，看些简单的也明白 ，就是一写傻眼了，各位朋友老师们，还要给我这个帖子多指点呀！
拜托！拜托！
选择了就不要放弃！

没人帮忙吗？
选择了就不要放弃！

有个vba的代码

vba
2

不会vba呀，要是有高手帮忙调整一下，小弟感激不尽呀
选择了就不要放弃！

額，，，這個...這程序寫得好長呢~~有些亂..樓主是要什麼效果呢？
標注方式為在一個直角三角形的兩直邊上標個數字，還算角度？
欢迎大家跟我交流lisp相关问题

真是漂亮

就是在一个直角三角形两个直角边上写上数字，以长边为基础，设为1000，短边为相应比例
选择了就不要放弃！
程序完成,兄弟你試試看哪要改的.
(defun c:daa()
(setq ocm (getvar "cmdecho")) (setvar "cmdecho" 0)
(setq oco (getvar "cecolor")) (setvar "cecolor" "6")
(setq oor (getvar "orthomode")) (setvar "orthomode" 0)
(if (null osc) (setq osc 1.0) )
(setq sca (getreal (strcat "\n輸入縮放比例:<" (rtos osc 2 1)"> ")) bzs "1")
(if (member sca '(nil "")) (setq sca osc) (setq osc sca) )
(initget "1 2") (setq mos (getkword "\n選擇標注移動方式: (1 移動/2 拉伸) <2> "))
(if (member mos '(nil "")) (setq mos "2") )
(setq pto (getpoint "\n選擇標注基點=>") pt1 (getpoint pto "\n選擇標注終點=>"))
(if pt1 (setq ang (angle pto pt1) an1 (/ (* ang 180) pi)) )
(while
(or
(= (rtos ang 2 4) (rtos (* pi 0.5) 2 4))
(= (rtos ang 2 4) (rtos pi 2 4))
(= (rtos ang 2 4) (rtos (* pi 1.5) 2 4))
(= (rtos ang 2 4) (rtos (* pi 2) 2 4))
(= (rtos ang 2 4) (rtos 0 2 4))
(null pt1)
)
(princ "\n未選擇終點或標注角度為90度和0度!")
(setq pt1 (getpoint pto "\n選擇標注終點=>")
ang (angle pto pt1) an1 (/ (* ang 180) pi)
)
)
(setq oos (getvar "osmode")) (setvar "osmode" 0)
(princ "\n 空格修改標注樣式,拖動鼠標移動標注")
(setq xxd (fix (/ an1 90)) an1 (- an1 (* xxd 90)) an2 (- 90 an1))
(cond
((> an1 an2) (setq te1 1000 te2 (fix (/ 1000 (/ an1 an2)))) )
((> an2 an1) (setq te2 1000 te1 (fix (/ 1000 (/ an2 an1)))) )
((= an1 an2) (setq te1 1000 te2 1000) )
)
(setq pox (car pto) poy (cadr pto) p1x (car pt1) p1y (cadr pt1))
(setq lo1 (distance pto pt1) re$ t) (draw_dim) (redrop_dim)
(setvar "osmode" oos) (setvar "cecolor" oco)
(setvar "orthomode" oor) (setvar "cmdecho" ocm) (princ)
)
(defun draw_dim()
(setq pt2 (polar pt1 ang (* sca 5))) (count_pts pt2)
(command "pline" pt2 "w" 0 0 pt3 pt5 pt4 "") (setq enl (entget (entlast)))
(setq p10t (vl-position (assoc 10 enl) enl)) (setvar "cecolor" "4")
(command "text" "j" "mc" tp1 (* sca 2.5) 0 (itoa tex1)) (setq ent1 (entget (entlast)))
(setq t1p2 (cdr (assoc 11 ent1)) dst1 (distance tp1 t1p2) ant1 (angle tp1 t1p2))
(command "text" "j" "mc" tp2 (* sca 2.5) 90 (itoa tex2)) (setq ent2 (entget (entlast)))
(setq t2p2 (cdr (assoc 11 ent2)) dst2 (distance tp2 t2p2) ant2 (angle tp2 t2p2))
)
(defun count_pts(pt2)
(setq pt3 (polar pt2 ang (* sca 30)) pt4 (polar pt2 ang (* sca 18)))
(if (= bzs "1")
(setq pt5 (list (car pt4) (cadr pt3) 0))
(setq pt5 (list (car pt3) (cadr pt4) 0))
)
(if (= (rtos (distance pt5 pt4) 2 3) (rtos (distance pt5 pt3) 2 3))
(setq tex1 1000 tex2 1000)
(if (> (distance pt5 pt4) (distance pt5 pt3))
(setq tex1 (min te1 te2) tex2 (max te1 te2))
(setq tex1 (max te1 te2) tex2 (min te1 te2))
)
)
(cond
((= xxd 0)
(if (= bzs "1")
(setq pxf pt3 pyf pt4 t1x pt5 t2y pt5
tp1 (polar (tp1_chek t1x pxf) (an_ang 90) (* sca 2))
tp2 (polar (tp2_chek t2y pyf) (an_ang 180) (* sca 2))
)
(setq pxf pt4 pyf pt3 t1x pt4 t2y pt3
tp1 (polar (tp1_chek t1x pxf) (an_ang 270) (* sca 2))
tp2 (polar (tp2_chek t2y pyf) (an_ang 0) (* sca 2))
)
)
)
((= xxd 1)
(if (= bzs "1")
(setq pxf pt3 pyf pt4 t1x pt3 t2y pt5
tp1 (polar (tp1_chek t1x pxf) (an_ang 90) (* sca 2))
tp2 (polar (tp2_chek t2y pyf) (an_ang 0) (* sca 2))
)
(setq pxf pt4 pyf pt3 t1x pt5 t2y pt3
tp1 (polar (tp1_chek t1x pxf) (an_ang 270) (* sca 2))
tp2 (polar (tp2_chek t2y pyf) (an_ang 180) (* sca 2))
)
)
)
((= xxd 2)
(if (= bzs "1")
(setq pxf pt3 pyf pt4 t1x pt3 t2y pt4
tp1 (polar (tp1_chek t1x pxf) (an_ang 270) (* sca 2))
tp2 (polar (tp2_chek t2y pyf) (an_ang 0) (* sca 2))
)
(setq pxf pt4 pyf pt3 t1x pt5 t2y pt5
tp1 (polar (tp1_chek t1x pxf) (an_ang 90) (* sca 2))
tp2 (polar (tp2_chek t2y pyf) (an_ang 180) (* sca 2))
)
)
)
((= xxd 3)
(if (= bzs "1")
(setq pxf pt3 pyf pt4 t1x pt5 t2y pt4
tp1 (polar (tp1_chek t1x pxf) (an_ang 270) (* sca 2))
tp2 (polar (tp2_chek t2y pyf) (an_ang 180) (* sca 2))
)
(setq pxf pt4 pyf pt3 t1x pt4 t2y pt5
tp1 (polar (tp1_chek t1x pxf) (an_ang 90) (* sca 2))
tp2 (polar (tp2_chek t2y pyf) (an_ang 0) (* sca 2))
)
)
)
)
)
(defun tp1_chek(t1x pxf)
(setq tp1 (polar t1x (an_ang 0) (/ (distance pt5 pxf) 2)))
)
(defun tp2_chek(t2y pyf)
(setq tp2 (polar t2y (an_ang 270) (/ (distance pt5 pyf) 2)))
)
(defun redrop_dim()
(while re$
(setq ju$ (grread 1 4) c1$ (car ju$) npt2 (cadr ju$))
(cond
((= c1$ 3) (setq re$ nil) )
((= c1$ 5) (redrop_dim2 npt2) )
((= c1$ 2)
(progn
(setq ju$ (grread 5) c1$ (car ju$) npt2 (cadr ju$))
(if (= bzs "1") (setq bzs "2") (setq bzs "1") )
(redrop_dim2 npt2)
)
)
)
)
)
(defun redrop_dim2(npt2)
(cond
((= xxd 0)
(progn
(setq npt2 (polar pto ang (max (- (car npt2) (car pto)) (- (cadr npt2) (cadr pto)))))
(if (< (- (car npt2) (car pt1)) (- (car pt2) (car pt1)) (* sca 5)) (setq npt2 pt2) )
)
)
((= xxd 1)
(progn
(setq npt2 (polar pto ang (max (- (car pto) (car npt2)) (- (cadr npt2) (cadr pto)))))
(if (< (- (car pt1) (car npt2)) (- (car pt1) (car pt2)) (* sca 5)) (setq npt2 pt2) )
)
)
((= xxd 2)
(progn
(setq npt2 (polar pto ang (max (- (car pto) (car npt2)) (- (cadr pto) (cadr npt2)))))
(if (< (- (car pt1) (car npt2)) (- (car pt1) (car pt2)) (* sca 5)) (setq npt2 pt2) )
)
)
((= xxd 3)
(progn
(setq npt2 (polar pto ang (max (- (car npt2) (car pto)) (- (cadr pto) (cadr npt2)))))
(if (< (- (car npt2) (car pt1)) (- (car pt2) (car pt1)) (* sca 5)) (setq npt2 pt2) )
)
)
)
(count_pts npt2) (setq t1p2 (polar tp1 ant1 dst1) t2p2 (polar tp2 ant2 dst2))
(if (= mos "1") (setq enl (subst (append '(10) npt2) (nth p10t enl) enl)) )
(setq enl (subst (append '(10) pt3) (nth (+ p10t 4) enl) enl))
(setq enl (subst (append '(10) pt5) (nth (+ p10t 8) enl) enl))
(setq enl (subst (append '(10) pt4) (nth (+ p10t 12) enl) enl))
(setq ent1 (subst (append '(10) tp1) (assoc 10 ent1) ent1))
(setq ent1 (subst (append '(11) t1p2) (assoc 11 ent1) ent1))
(setq ent2 (subst (append '(10) tp2) (assoc 10 ent2) ent2))
(setq ent2 (subst (append '(11) t2p2) (assoc 11 ent2) ent2))
(entmod ent2) (entmod ent1) (entmod enl)
)
(defun an_ang(an) (/ (* an pi) 180) )
欢迎大家跟我交流lisp相关问题

空格鍵更換標注方式也修改好了，只有圖層還沒有去做，因為不知道你想要放在哪個層。
欢迎大家跟我交流lisp相关问题