[求助]：麻烦编写如下LISP ,急!

xyp1964

[php]

最初由 aeo 发布
[B]

是pl线，炸开，nentselp选到变... [/B]

炸开就不必了！
搞定！再试试！
增加坡度段红色显示及0度、90度判断！
程序内容如下：

;|
PDPC.lsp 坡度坡长
* C:PDPC
2004.10.17
|;
(prompt "\n\r      加载坡度坡长程序。")
;-------------------------------------------
;;;主程序
(defun c:pdpc (/ s1 st dist pd pts pte )
  (cmdla0)
  (VL-LOAD-COM)
  (setq        s1 (entsel "\n\t选择LINE、POLYLINE或LWPLINE实体 : ")
        st (cdr (assoc 0 (entget (car s1))))
  )
  (if (= st "LINE")
    (endpt1 (car s1))
    (progn
      (if (or (= st "POLYLINE") (= st "LWPLINE"))
        (endpt2 s1)
        (progn
          (princ "\n\t无效选择，不是LINE、POLYLINE或LWPLINE实体!")
          (exit)
          )
        )
      )
    )
  (if (and pts pte)
    (progn
      (setq dist (abs (distance pts pte)))
      (grvecs (list 1 pts pte ))
      )
    );坡长
  (if (and (/= pte nil)(/= pts nil)(/= (car pts) (car pte)))
        (progn
          (setq pd (/ (- (cadr pts) (cadr pte))(- (car pts) (car pte))))
          (if (/= pd 0)
            (progn
              (princ "\n\t坡长 = ")(princ dist)(princ "  坡度 = 1:")(princ (abs (/ 1 pd)))(princ))
            (progn
              (princ "\n\t坡长 = ")(princ dist)(princ "  坡度 = 0度 !")
              )
            )
          )
        (progn
          (princ "\n\t坡长 = ")(princ dist)(princ "  坡度 = 90度 !")
        )
        )
  (cmdla1)
  (pxyp"PDPC      (坡度坡长)")
)

;;;-------------------------------------------
;;;通用子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
  )

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
  )

(defun endpt1 (s1)
  (setq        eobj (vlax-ename->vla-object s1)
        pts  (vlax-curve-getstartpoint eobj)
        pte  (vlax-curve-getendpoint eobj)
  )
)
(defun endpt2 (s1)
  (setq eobj (vlax-ename->vla-object (car s1)))
  (setq pt (cadr s1))
  (setq cpt (vlax-curve-getClosestPointTo eobj pt T))
  (setq n (fix (vlax-curve-getParamAtPoint eobj cpt))
        pts (vlax-curve-getPointAtParam eobj n)
        pte (vlax-curve-getPointAtParam eobj (1+ n))
        )
)
;;;
(DEFUN PXYP (TXT1)
  (SETQ        TXT1 (STRCAT "\n\r      程序命令: "  TXT1 "      -- XYP@bsedi.com"))
  (PRINC TXT1)
  (Princ)
  );defun

;;;
(pxyp"PDPC      (坡度坡长)")
(princ)
;-------------------------------------------
;;;END[/php]

jerry_bj

测试了一下 好象还是不行 对PLINE线的情况
选择LINE、POLYLINE或LWPLINE实体 :
无效选择，不是LINE、POLYLINE或LWPLINE实体!; error: quit / exit abort

直线的可以 但是不要显示后改变直线属性 谢谢

梦断江南

这样就可以了
[php]
;; pdu = 显示直线或多义线的片断长度,坡度.--------------梦断江南.2004.10                    
(defun c:pdu (/ pt p1 p2 len pd)
  (while (and (setq el (entsel "\n选line,*polyline / [退出(x)]:")
                    e  (car el))
              (wcmatch (cdr(assoc 0 (entget e))) "LINE,*POLYLINE"))
    (setq pt  (cadr el)
          p1  (osnap pt "mid")
          p2  (osnap pt "end")
          len (* 2 (distance p1 p2))
          pd  (rem (angle p1 p2)PI)
          pd  (if (< pd (* 0.5 PI)) (angtos pd 0 2) (angtos (- PI pd) 0 2)))
    (mapcar 'princ (list "\n长度 = " len "    坡度 = " pd ))
  )(princ)
)
[/php]

jerry_bj

测试后 还行 但是坡度的计算结果不正确  为什么呢
为什么不用 P2-P1的群码的纵坐标差值除以横坐标差值这种方法计算坡度呢

xyp1964

最初由 jerry_bj 发布
[B]测试了一下 好象还是不行 对PLINE线的情况
选择LINE、POLYLINE或LWPLINE实体 :
无效选择，不是LINE、POLYLINE或LWPLINE实体!; error: quit / exit abort

直线的可以 但是不要显示后改变直线属性 谢谢 [/B]

1. 是不是选了非pline线？
2. 显示后并没有改变直线属性。
我也再测试一下，最好提供一个参考DWG文件。

jerry_bj

最初由 xyp1964 发布
[B][QUOTE]最初由 jerry_bj 发布
[B]测试了一下 好象还是不行 对PLINE线的情况
选择LINE、POLYLINE或LWPLINE实体 :
无效选择，不是LINE、POLYLINE或LWPLINE实体!; error: quit / exit abort

直线的可以 ... [/B]

刚才我回复的是梦江南的

XYP兄 你的我也测试过 每次加载后 命令PDPC
点 pline 线 它就出来
选择LINE、POLYLINE或LWPLINE实体 :
无效选择，不是LINE、POLYLINE或LWPLINE实体!quit / exit abort

不知道是什么原因 望回复

xyp1964

又测试，没问题！用的是2004以上版本？

梦断江南

最初由 jerry_bj 发布
[B]测试后 还行 但是坡度的计算结果不正确  为什么呢
为什么不用 P2-P1的群码的纵坐标差值除以横坐标差值这种方法计算坡度呢 [/B]

讲讲你平时是什么情况下用的
我写的时候的确是有两个版本,另外一个就是你说的方法.
这个的角度是相当于当前ucs的.

LIFUPING

梦断江南斑竹的程序思路很明确，简结易懂，可能是专业问题，还没搞清“坡度”的概念，其实坡度：i=tgα=（y1-y2）/（X1-X2），实际上就是求线段倾斜角度的正切值。斑竹的程序是不是只求出了角度值而没算坡度i值？如是只要稍加改动就行了。
另外楼主的要求不只是求坡度的问题，而是要求在屏幕上直接显示其坡度值。

梦断江南

[php]
;; jdu = 显示直线或多义线的片断长度,角度(ucs)--------梦断江南.2004.10                    
(defun c:jdu (/ pt p1 p2 len pd)
  (while (and (setq el (entsel "\n选line,*polyline / [退出(x)]:")
                    e  (car el))
              (wcmatch (cdr(assoc 0 (entget e))) "LINE,*POLYLINE"))
    (setq pt  (cadr el)
          p1  (osnap pt "mid")
          p2  (osnap pt "end")
          len (* 2 (distance p1 p2))
          pd  (rem (angle p1 p2)PI)
          pd  (if (< pd (* 0.5 PI)) (angtos pd 0 2) (angtos (- PI pd) 0 2))
          pd  (atan pd))
    (mapcar 'princ (list "\n长度 = " len "    角度 = " pd ))
  )(princ)
)
;;'pdu = 显示直线或多义线的片断长度,坡度.
(defun c:pdu (/ pt p1 p2 len pd)
  (while (and (setq el (entsel "\n选line,*polyline / [退出(x)]:")
                    e  (car el))
              (wcmatch (cdr(assoc 0 (entget e))) "LINE,*POLYLINE"))
    (setq pt  (cadr el)
          p1  (osnap pt "mid")
          p2  (osnap pt "end")
          len (* 2 (distance p1 p2))
          pd  (rem (angle p1 p2)PI)
          pd  (if (< pd (* 0.5 PI)) pd (- PI pd));;修改；
          pd  (/ (sin  pd) (cos pd))) ;;加了这行，
    (mapcar 'princ (list "\n长度 = " len "    坡度 = " pd ))
  )(princ)
)
[/php]

jerry_bj

测试后，梦版版写的不错！完全满意 谢谢！

zh_6531394

如果坡度能直接标注在图上就好了

xyp1964

最初由 梦断江南 发布
[B][php]
;; jdu = 显示直线或多义线的片断长度,角度(ucs)--------梦断江南.2004.10                    
(defun c:jdu (/ pt p1 p2 len pd)
  (while (and (setq el (entsel "\n选line,*polyline / [退出(x)]:")
                    e  (car e... [/B]

当线为垂直线（90度）时出错：
长度 = 6302.47    坡度 = 1.63318e+016
另：坡度一般用1：？或？‰表示比较好理解。