冬至有点冷，给菜鸟送菜，标水平垂直角

wzg356 · 发表于 2014-12-22 22:06:06

刚写玩的，抛砖引玉

你有更好的请奉献出来

标水平角

;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)
(setq pp (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
p2 p1
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:tt1 ( / PickSegEndPt en enl enl2 p1 p2 p3 p4 
          p1p2 d14 gr gr-model gr-value tmp) 
;;多段线所点击子段的两端点列表,from 明经 
(defun PickSegEndPt (obj p / pp n) 
  (setq  pp (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 
        p2  p1 
        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)
(setq pp (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
p2 p1
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)
)

;;;标垂直角 
;;;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) 
  (setq  pp (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 
        p2  p1 
        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:28

感谢楼主分享！网络不行不能评分，奇怪同一台电脑，用公司的网络没问题，家里的网络就不能评分，上传图片

wzg356 · 发表于 2014-12-22 23:36:44

lucas_3333 发表于 2014-12-22 22:50
感谢楼主分享！网络不行不能评分，奇怪同一台电脑，用公司的网络没问题，家里的网络就不能评分，上传图片

有你看很荣幸了，我今年才学lsp。
以前有用过你的程序，指点为感！

lucas_3333 · 发表于 2014-12-23 08:13:22

wzg356 发表于 2014-12-22 23:36
有你看很荣幸了，我今年才学lsp。
以前有用过你的程序，指点为感！

这样说太谦虚啦，我也是初学者

账号		自动登录	找回密码
密码			注册

[基础] 冬至有点冷，给菜鸟送菜，标水平垂直角

评分

相关帖子