冬至有点冷，给菜鸟送菜，标水平垂直角
刚写玩的，抛砖引玉你有更好的请奉献出来
标水平角;wzg 356 于20141221
(defun c:tt1 ( / PickSegEndPt en enl enl2 p1 p2 p3 p4
p1p2 d14 gr gr-model gr-value tmp)
;;多段线所点击子段的两端点列表,from 明经
(defun PickSegEndPt (obj p / pp n)
(setqpp (vlax-curve-getclosestpointto obj (trans p 1 0))
n(fix (vlax-curve-getparamatpoint obj pp)))
(list(vlax-curve-getPointAtParam obj n)
(vlax-curve-getPointAtParam obj (1+ n)))
)
;;循环选则直到选中符合过滤的实体为止
(while
(not
(and
(setq en (entsel "\n选择直线..."))
(or(= (cdr (assoc 0 (setq enl(entget(car en))))) "POLYLINE")
(= (cdr (assoc 0 enl)) "LWPOLYLINE")
(= (cdr (assoc 0 enl)) "LINE")
)
)
)
)
(if(= (cdr (assoc 0 enl)) "LINE")
(setq p1 (cdr (assoc 10 enl))
p2 (cdr (assoc 11 enl))
)
(progn
(setq p1p2(PickSegEndPt (car en) (cadr en)))
(setq p1 (car p1p2)
p2 (cadr p1p2)
)
)
)
(if (>
(distance (setq p4(cadr(grread 5))) p1)
(distance p4 p2)
)
(setq tmp p2
p2p1
p1 tmp
)
)
(setq p3 (polar p1 0 (distance p1 p4)))
(setvar "cmdecho" 0)
(command "_dimangular" "" "non" p1 "non" p2 "non" p3 "non" p4)
(setq enl(entget(setq en (entlast))))
(command "_line" "non" p1 "non" p3 "")
(setq enl2(entget(entlast)))
(setq gr 0 gr-model 0 gr-value 0 );;gr-model必须归零
(while (/= gr-model 3) ;鼠标左键
(setq gr (grread T 8)
gr-model (car gr)
gr-value (cadr gr);鼠标位置
)
(if(and gr (=gr-model 5));鼠标移动
(progn
(setq d14 (distance p1 gr-value))
(if (> (car gr-value)(car p1))
(setq p3 (polar p1 0 d14))
(setq p3 (polar p1 pi d14))
)
(setq p2 (polar p1 (angle p1 p2) d14))
(setq enl (subst (cons 14 p3) (assoc 14 enl) enl)
enl (subst (cons 13 p2) (assoc 13 enl) enl)
enl (subst (cons 10 gr-value) (assoc 10 enl) enl)
enl2 (subst (cons 11 p3) (assoc 11 enl2) enl2)
)
(entmod enl)
(entmod enl2)
)
)
)
(setvar "cmdecho" 1)
(princ (strcat"\n角度=" (rtos (/ (* (cdr (assoc 42 (entget en)))180) pi) 2 2) "°"))
(PRINC)
);;;标垂直角
;;;wzg 356 于20141221
(defun c:tt2 ( / PickSegEndPt en enl enl2 p1 p2 p3 p4
p1p2 d14 gr gr-model gr-value tmp)
;;多段线所点击子段的两端点列表
(defun PickSegEndPt (obj p / pp n)
(setqpp (vlax-curve-getclosestpointto obj (trans p 1 0))
n(fix (vlax-curve-getparamatpoint obj pp)))
(list(vlax-curve-getPointAtParam obj n)
(vlax-curve-getPointAtParam obj (1+ n)))
)
;;循环选则直到选中符合过滤的实体为止
(while
(not
(and (setq en (entsel "\n选择直线..."))
(setq enl(entget(car en)))
(or(= (cdr (assoc 0 enl)) "POLYLINE")
(= (cdr (assoc 0 enl)) "LWPOLYLINE")
(= (cdr (assoc 0 enl)) "LINE")
)
)
)
)
(if(= (cdr (assoc 0 enl)) "LINE")
(setq p1 (cdr (assoc 10 enl))
p2 (cdr (assoc 11 enl))
)
(progn
(setq p1p2(PickSegEndPt (car en) (cadr en)))
(setq p1 (car p1p2)
p2 (cadr p1p2)
)
)
)
(if (>
(distance (setq p4(cadr(grread 5))) p1)
(distance p4 p2)
)
(setq tmp p2
p2p1
p1 tmp
)
)
(setq p3 (polar p1 (* pi 0.5) (distance p1 p4)))
(setvar "cmdecho" 0)
(command "_dimangular" "" "non" p1 "non" p2 "non" p3 "non" p4)
(setq enl(entget(setq en (entlast))))
(command "_line" "non" p1 "non" p3 "")
(setq enl2(entget(entlast)))
(setq gr 0 gr-model 0 gr-value 0 );;gr-model必须归零
(while (/= gr-model 3) ;鼠标左键
(setq gr (grread T 8)
gr-model (car gr)
gr-value (cadr gr);鼠标位置
)
(if(and gr (=gr-model 5));鼠标移动
(progn
(setq d14 (distance p1 gr-value))
(if (> (cadr gr-value)(cadr p1))
(setq p3 (polar p1 (* pi 0.5) d14))
(setq p3 (polar p1 (* pi -0.5) d14))
)
(setq p2 (polar p1 (angle p1 p2) d14))
(setq enl (subst (cons 14 p3) (assoc 14 enl) enl)
enl (subst (cons 13 p2) (assoc 13 enl) enl)
enl (subst (cons 10 gr-value) (assoc 10 enl) enl)
enl2 (subst (cons 11 p3) (assoc 11 enl2) enl2)
)
(entmod enl)
(entmod enl2)
)
)
)
(setvar "cmdecho" 1)
(princ (strcat"\n角度=" (rtos (/ (* (cdr (assoc 42 (entget en)))180) pi) 2 2) "°"))
(PRINC)
) 感谢楼主分享！ 网络不行不能评分，奇怪同一台电脑，用公司的网络没问题，家里的网络就不能评分，上传图片 lucas_3333 发表于 2014-12-22 22:50 static/image/common/back.gif
感谢楼主分享！ 网络不行不能评分，奇怪同一台电脑，用公司的网络没问题，家里的网络就不能评分，上传图片
有你看很荣幸了，我今年才学lsp。
以前有用过你的程序，指点为感！ wzg356 发表于 2014-12-22 23:36 static/image/common/back.gif
有你看很荣幸了，我今年才学lsp。
以前有用过你的程序，指点为感！
这样说太谦虚啦，我也是初学者 有视频吗不知道用途
页:
[1]