坡度标注（Lsp）

一位网友不知从哪里下载了一个小程序，

进行坡度标注，

但不满足他的要求，

他需要增加箭头、增加百分率、比例选项，

让我帮他修改，

这是修改后的程序，

有需求的朋友们可以下载测试。

代码如下：

(defun c:nn (/ a a1 d dx dy i os p1 p2 pmid str stri)
  (princ "
欢迎使用坡度标注程序！  gysjy 2009.6.27. ")
  (command "undo" "g")
  (setq os (getvar "osmode"))
  (setvar "osmode" 1)
  (initget "G S")
  (setq k (getkword "
[百分率(G)/比例(S)]<G>:"))

;;;    箭头相关的参数
  (setq    al1 6.5
;;;上面的变量是箭线长度一半，可以修改
    al2 3.0
;;;箭头长度
    aw  0.2
;;;箭头宽度
    al3 1.0
;;;箭线到待标线距离
    al4 3.5
;;;文本到直线的距离

;;;以上的参数可以进行修改，注释在下，参数在上
  )
  (mm k al1 al2 aw al3 al4)
)



(defun mm (k al1 al2 aw al3 al4)
  (setq    p1 (getpoint "
第一点：")
  )
  (if (= nil p1)
    (quit)
  )
  (setq
    p2 (getpoint "
第二点：" p1)
  )
  (if (= nil p2)
    (quit)
  )
  (setq
    a     (angle p1 p2)
    d     (/ (distance p1 p2) 2)
    pmid (polar p1 a d)

    at     (if (and (> a 1.571) (< a 4.713))
       (- a pi)
       a
     )
    aa     (+ at (* 0.5 PI))
    ap1     (polar (polar pmid a (- al1)) aa al3)
;;;箭线起点
    ap2     (polar (polar pmid a al1) aa al3)
;;;箭线终点
    ap3     (polar ap2 a (- al2))
;;;箭头终点辅助点
;;;    
    ap4     (polar ap3 aa (* al2 aw))
;;;箭头终点
;;;    ap5  (polar ap3 (+ a 1.57) (* al2 -0.2))

    pmid (polar pmid aa al4)



;;;    a    (* a 57.3)
    dx     (- (car p1) (car p2))
    dy     (- (cadr p1) (cadr p2))
  )
  (if (= k "G")
    (setq

      i       (if (= dx 0)
         10000
         (* 100 (abs (/ dy dx)))
       )
      stri (rtos i 2 1)
      str  (if (= dx 0)
         "垂直"
         (strcat "i=" stri "%")
       )
    )
    (setq i    (if (= dx 0)
         0
         (abs (/ dy dx))
           )
      stri (rtos i 2 2)
      str  (if (= dx 0)
         "垂直"
         (strcat "i=1:" stri)
           )
    )
  )
  (setvar "osmode" os)
;;;  (grdraw p1 p2 2)
;;;;;;  (command "text" "j" "m" pmid "2.5" a str)

  (entmake (list
         '(0 . "TEXT")
         '(8 . "箭头")
         '(40 . 2.5)
         '(72 . 4)
         '(73 . 0)
         (cons 50 at)
         (cons 1 str)
         (cons 10 pmid)
         (cons 11 pmid)
       )
  )


;;;添加箭头

  (entmake (list
         '(0 . "LINE")
         '(8 . "箭头")
         (cons 10 ap1)
         (cons 11 ap2)
       )
  )
  (entmake (list
         '(0 . "LINE")
         '(8 . "箭头")
         (cons 10 ap2)
         (cons 11 ap4)
       )
  )
  (mm k al1 al2 aw al3 al4)
  (command "undo" "e")
  (princ)
)