根据坡比划线并标注
本帖最后由 sandyvs 于 2023-1-17 11:59 编辑网上找的程序，划线并标注坡比。
(defun c:PD( / bd ang stp enp p1 gr p0)
(vl-load-com)
(setvar "DYNMODE" 0)
(setvar "nomutt" 0)
(setq SCALE (GETVAR "DIMSCALE"))
(setq DIMHEIGHT 2.5)
(defun gxl-error(fun)
(setq *olderror* *error*
*Function* fun)
(defun *error*(msg)
(if *Function*
(VL-CATCH-ALL-APPLY *Function*))
(setq *error* *olderror*
*olderror* nil
*Function* nil))
(princ))
(defun re () (setvar "nomutt" 0) (redraw))
(gxl-error 're)
(if (= aa nil)(setq aa 1))
(if (null (setq bd (getreal (strcat "\n输入坡度 1: <" (vl-princ-to-string aa) ">" ))))
(setq aa aa)
(setq aa bd))
(setvar "DYNMODE" 1)
(setq ang (atan (/ 1 aa)))
(setq stp (getpoint "\n输入或拾取起点："))
(setq p1 (polar stp ang 1e2))
(while (not (member (car (setq gr (grread t 13 0))) '(2 3 25)))
(redraw)
(setq p0 (polar (cadr gr) (+ ang (/ pi 2)) 1e2))
(setq enp (inters stp p1 p0 (cadr gr) nil))
(grvecs (list -3 stp enp)))
(entmake (list '(0 . "LINE") (cons 10 stp) (cons 11 enp)))
(setq mip (mapcar '(lambda (x y) (/ (+ x y) 2)) stp enp))
(setq aa (abs aa))
(entmake (list '(0 . "TEXT")
(cons 40 (* SCALE DIMHEIGHT))
(cons 41 0.85)
(cons 1 (strcat "1:" (if (eq aa (fix aa))(rtos aa 2 0) (vl-princ-to-string aa))))
(cons 10 mip)
(cons 50 ang)
'(72 . 1)
(cons 11 mip)))
(vla-put-Alignment (vlax-ename->vla-object (entlast)) 13)
(redraw)
(princ))
sandyvs 发表于 2023-1-17 10:31
额，不会编程，我把strcat那加了绝对值，结果不输出了。。加在文字之前就可以了
(defun c:PD( / bd ang stp enp p1 gr p0)
(vl-load-com)
(setvar "DYNMODE" 0)
(setvar "nomutt" 0)
(setq SCALE (GETVAR "DIMSCALE"))
(setq DIMHEIGHT 2.5)
(defun gxl-error(fun)
(setq *olderror* *error*
*Function* fun)
(defun *error*(msg)
(if *Function*
(VL-CATCH-ALL-APPLY *Function*))
(setq *error* *olderror*
*olderror* nil
*Function* nil))
(princ))
(defun re () (setvar "nomutt" 0) (redraw))
(gxl-error 're)
(if (= aa nil)(setq aa 1))
(if (null (setq bd (getreal (strcat "\n输入坡度 1: <" (vl-princ-to-string aa) ">" ))))
(setq aa aa)
(setq aa bd))
(setvar "DYNMODE" 1)
(setq ang (atan (/ 1 aa)))
(setq stp (getpoint "\n输入或拾取起点："))
(setq p1 (polar stp ang 1e2))
(while (not (member (car (setq gr (grread t 13 0))) '(2 3 25)))
(redraw)
(setq p0 (polar (cadr gr) (+ ang (/ pi 2)) 1e2))
(setq enp (inters stp p1 p0 (cadr gr) nil))
(grvecs (list -3 stp enp)))
(entmake (list '(0 . "LINE") (cons 10 stp) (cons 11 enp)))
(setq mip (mapcar '(lambda (x y) (/ (+ x y) 2)) stp enp))
(setq aa (abs aa))
(entmake (list '(0 . "TEXT")
(cons 40 (* SCALE DIMHEIGHT))
(cons 41 0.85)
(cons 1 (strcat "1:" (if (eq aa (fix aa))(rtos aa 2 0) (vl-princ-to-string aa))))
(cons 10 mip)
(cons 50 ang)
'(72 . 1)
(cons 11 mip)))
(vla-put-Alignment (vlax-ename->vla-object (entlast)) 13)
(redraw)
(princ))
本帖最后由 sandyvs 于 2023-1-17 10:29 编辑
自贡黄明儒 发表于 2023-1-17 10:10
(setq aa bd))后面加一句(setq aa (abs aa))试试。
不行呀黄老师，正的是往左坡，负的是往右坡，改成正的之后就不能往右画坡了，我是想怎么把标注那改成正的 自贡黄明儒 发表于 2023-1-17 10:28
根据角度判断一下，正的加abs
额，不会编程，我把strcat那加了绝对值，结果不输出了。。 (setq aa bd))后面加一句(setq aa (abs aa))试试。 sandyvs 发表于 2023-1-17 10:26
不行呀黄老师，正的是往左坡，负的是往右坡，
根据角度判断一下，正的加abs
tigcat 发表于 2023-1-17 11:30
感谢回复，应该不用判断是否小于0，反正要标的都是正的 sandyvs 发表于 2023-1-17 11:56
感谢回复，应该不用判断是否小于0，反正要标的都是正的
的确不用判断
支持一下看看
页:
[1]
2