AutoCAD地质剖面结构面产状计算lisp代码
需积分: 26 134 浏览量
2011-01-29
16:04:01
上传
评论 2
收藏 15KB DOCX 举报
AutoCAD 地质剖面结构面产状计算 lisp 代码
地质剖面图上的断层等结构面是视倾角，需要根据断层倾向与剖面方向的关系计算。下面
的代码能完成计算断层的视倾角，并画出其剖面示意线，标出断层的编号和产状。
(defun c:yfapm (/ anga angb fanu angc pt p pt1 pt2 pt3 os qx ak bk e f d g yy fa)
(setvar "cmdecho" 0)
(setq anga (getreal " 请输入剖面方向(度): "))
(setq fanu (getstring " 请输入断层编号: "))
(setq angb (getreal " 请输入断层走向(度): "))
(setq qx (strcase (getstring " 请输入断层倾向(NE、NW、SE、SW、N、E、S、W): ")))
(setq angc (getreal " 请输入断层倾角(度): "))
(setq yxblf yxbl)
(if (null yxblf) (setq yxblf 1000))
(princ " 请输入 X 方向的比例< ") (princ yxblf) (princ " >: ")
(setq yxbl (getreal ))
(if (null yxbl) (setq yxbl yxblf))
(setq yyblf yybl)
(if (null yyblf) (setq yyblf 1000))
(princ " 请输入 Y 方向的比例< ") (princ yyblf) (princ " >: ")
(setq yybl (getreal ))
(if (null yybl) (setq yybl yyblf))
(setq pt (getpoint " 请指定断层通过点： "))
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq ak (tan (- 90 anga)))
(setq bk (tan (- 90 angb)))
(setq e (atan (abs (/ (- ak bk) (1+ (* ak bk))))))
(setq f (angtos (atan (* (abs (sin e)) (tan angc) (/ yxbl yybl))) 0 10))
(cond
((= qx "NW") (setq d (+ angb 270)))
((= qx "SE") (setq d (+ angb 90)))
((= qx "NE") (setq d (- angb 270)))
((= qx "SW") (setq d (- angb 90)))
((= qx "N") (setq d 0))
((= qx "E") (setq d 90))
((= qx "S") (setq d 180))
((= qx "W") (setq d 270))
)
(setq g (abs (- d anga)))
(if (and (> g 90)(< g 270))
(setq yy "相反")
(setq yy "一致" ))
(if (or (= g 90)(= g 270))
(setq yy "平行"))
(if (= yy "相反")
评论0
最新资源