[分享]：画结构面赤平极射投影图的lsp程序

jsrlb

俺做啦一个画结构面赤平极射投影图的lsp程序，与大家分享。

(defun c:CPT
           (/ oce1 oce2        p1 pz1 R n1 n2 qxc qxp qx
            qjp qj pt1 pt2 pt3 a1 str)

  (command "undo" "be")
  (setq        oce1 (getvar "cmdecho")
        oce2 (getvar "OSNAPCOORD")
  )
  (setvar "cmdecho" 0)
  (setvar "OSNAPCOORD" 1)

  (command "-style" "BG_ST" "宋体" 0 0.8 0 "n" "n")
  (initget 1)
  (setq        p1  (getpoint "\n请指定绘图基点: ")
        pz1 (polar p1 0 35)
        R   25;;;大圆半径
  )
  (command "zoom" "w" (polar p1 (* pi 0.5) 40) (polar p1 (* pi 1.5) 50))




  (command "line" (polar p1 pi 2.5)(polar p1 0 2.5) "")
  (command "line" (polar p1 (* pi 0.5) 2.5)(polar p1 (* pi 1.5) 2.5) "")
  (command "line" (polar p1 0 25)(polar p1 0 26.5) "")
  (command "line" (polar p1 (* pi 0.5) 25)(polar p1 (* pi 0.5) 26.5) "")
  (command "line" (polar p1 pi 25)(polar p1 pi 26.5) "")
  (command "line" (polar p1 (* pi 1.5) 25)(polar p1 (* pi 1.5) 26.5) "")
  (command "circle" p1 R)
  (command "text" "ml" (polar p1 0 28) 2.5 0 "E")
  (command "text" "bc" (polar p1 (* pi 0.5) 28) 2.5 0 "N")
  (command "text" "mr" (polar p1 pi 28) 2.5 0 "W")
  (command "text" "tc" (polar p1 (* pi 1.5) 28) 2.5 0 "S")




  (command "text"
             "m"
             (polar p1 (* pi 1.5) 38)
             3.2
             0
           "结构面赤平极射投影图"
  )

  (setq        n1 1
        n2 888
  )
  (while (= n2 888)
    (setq qxc 888)
    (while (= qxc 888)
      (if (not
            (setq qxp (getint "\n输入结构面倾向<退出>: "))
          )
        (setq qxc 886)
      )

      (if (= qxc 886)
        (setq qxc 886)
        (cond
          ((< qxp 0)
           (setq qxc 888)
           (princ "\---倾向数值太小,重新输入---")
          )
          ((> qxp 360)
           (setq qxc 888)
           (princ "\---倾向数值太大,重新输入---")
          )
          (t (setq qxc 880))
        )
      )
    )
    (if        (= qxc 880)
      (setq qx (/ (* (- 90 qxp) PI) 180))
    )
    (if        (= qxc 886)
      (setq qxc 886)
      (setq qxc 888)
    )
    (while (= qxc 888)
      (if (not
            (setq qjp (getint "\n输入结构面倾角<退出>: "))
          )
        (setq qxc 886)
      )

      (if (= qxc 886)
        (setq qxc 886)
        (cond
          ((< qjp 1)
           (setq qxc 888)
           (princ "\---倾角数值太小,重新输入---")
          )
          ((> qjp 89)
           (setq qxc 888)
           (princ "\---倾角数值太大,重新输入---")
          )
          (t (setq qxc 880))
        )
      )
    )

    (if        (= qxc 880)
      (setq qj (/ (* qjp PI) 180))
    )
    (cond
      ((= qxc 880)
       (progn
         (setq pt1 (polar p1 (- qx (/ PI 2)) R))
         (setq a1 (/ (sin (- (/ PI 4) (/ qj 2)))
                     (cos (- (/ PI 4) (/ qj 2)))
                  )
         )
         (setq pt2 (polar p1 (+ qx PI) (* R a1)))
         (setq pt3 (polar p1 (+ qx (/ PI 2)) R))
         (command "arc" pt1 pt2 pt3)
         (command "text" "m" pt2 2.5 0 n1)
       )
      )
      (t
       (progn
         (princ)
       )
      )
    )
    (cond
      ((= qxc 880)
       (progn
         (setq
           str (strcat (itoa n1)
                       "、结构面产状："
                       (itoa qxp)
                       "°∠"
                       (itoa qjp)
                       "°"
               )
         )
         (command "text" "tl" pz1 2.8 0 str)
         (setq n1  (1+ n1)
               pz1 (polar pz1 (* pi 1.5) 6)
               n2  888
         )
       )
      )
      (t
       (progn
         (setq n2 886)
       )
      )
    )
  )
  (setvar "cmdecho" oce1)
  (setvar "OSNAPCOORD" oce2)
  (command "undo" "e")
  (princ)
)

cqnj023

为什么角度要限制成整数呢

jsrlb

在野外用罗盘测量产状，只能读到整数，不会精确到0.1度的。
当然你如果要精确到小数，把getint改为getreal就行啦。

dqs007

这个东西可以!支持!