明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1572|回复: 5

根据正确三角网计算坡顶或者坡脚位置

[复制链接]
发表于 2016-10-27 22:32 | 显示全部楼层 |阅读模式
  1. ;;;by Gu_xl
  2. (defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
  3. (vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
  4.   (regapp "SOUTH")
  5.   (setvar "CMDECHO" 0)
  6.   (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")
  7.   (if height
  8.     (setq height (rtos height 2 3));3为高程注记位数
  9.     (setq height "")
  10.   )
  11.   (regapp "SOUTH")
  12.   
  13.   ;;;检查字体 "HZ" 是否存在
  14.   (if (not (tblobjname "style" "宋体"))
  15.     ;(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  16.     (command "style" "宋体" "" 0 1 0 "" "" "")
  17.   )
  18.   ;;;检查是否存在高程点图块定义
  19.   (if (not (tblobjname "block" "GC200"))
  20.     (progn
  21.       (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
  22.       (setq obj
  23.         (vla-AddPolyline
  24.            blkdef
  25.            (vlax-make-variant
  26.               (vlax-safearray-fill
  27.                  (vlax-make-safearray vlax-vbdouble (cons 0 5))
  28.                  '(-0.2 0 0 0.2 0 0)
  29.               )
  30.            )
  31.         )
  32.       )
  33.       (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
  34.       (vla-put-Closed obj :vlax-true)
  35.       (vla-put-ConstantWidth obj 0.4)
  36.     )
  37.   )
  38.   ;;;插入块
  39.   (entmake (list
  40.              '(0 . "INSERT")
  41.              '(100 . "AcDbEntity")
  42.              '(100 . "AcDbBlockReference")
  43.              '(66 . 1);;;属性跟随标志,1跟随,0不跟随
  44.               (cons 2 "GC200")
  45.               (cons 10 inspt)
  46.               (cons 41 scale)
  47.               (cons 42 scale)
  48.               (cons 43 scale)
  49.               (list -3 '("SOUTH" (1000 . "202101")))
  50.            )
  51.   )
  52.   ;;;插入属性
  53.   (entmake (list
  54.              '(0 . "ATTRIB")
  55.              '(100 . "AcDbEntity")
  56.              '(100 . "AcDbText")
  57.               (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
  58.               (cons 40 (* 2.0 scale))
  59.               (cons 50 0)
  60.               (cons 41 0.8)
  61.               (cons 51 0)
  62.               (cons 1 height)
  63.               (cons 7 "宋体")
  64.        (cons 62 3)
  65.               (cons 72 0)
  66.               (cons 11 pt)
  67.               '(100 . "AcDbAttribute")
  68.               (cons 2 "height")
  69.               (cons 70  0)
  70.               (cons 74 2)
  71.            )
  72.    )
  73.    ;;;结束标志
  74.    (entmake '((0 . "SEQEND")))
  75.    (princ)
  76. )
  77. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78. (defun PoInPl(pt p / n i va ang);;该过程由 StEf  44604813提供,本人只是把输出由原来的t,nil改为了-1,0,1
  79.       (setq n(length pt)
  80.       pt(append pt(list(car pt)))i 0 ang 0)
  81.       (while(< i n)
  82.   (setq va(-(angle p(nth i pt))(angle p(nth(1+ i)pt))))
  83.   (if (<(abs(-(abs va)pi))0.000001)(setq ang 2 i n)
  84.     (progn(cond((> va pi)(setq va (- va pi)))
  85.          ((< va (* -1 pi))(setq va (+ va pi))))
  86.       (setq ang(+ ang va)i(1+ i)))))
  87.       (if(= ang 2)0
  88.   (if(<(abs(-(abs ang) pi))0.000001)1 -1))
  89.       )
  90. ;defun
  91. (defun plinexy(e / a q m p);;;LWPolyline,POLYLINE顶点,去掉完全重合点
  92.     (setq a(vlax-ename->vla-object e)
  93.   q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
  94.     m(vla-get-objectname a)a 0
  95.     m(if(= m"AcDb3dPolyline")3 2))
  96.     (repeat(/(length q)m)
  97.       (cond((= m 2)(setq p1(list(nth a q)(nth(+ a 1)q))))
  98.      ((= m 3)(setq p1(list(nth a q)(nth(+ a 1)q)(nth(+ a 2)q)))))
  99.       (setq p(if (member p1 p)p (append p(list p1)))
  100.       a(+ a m)))
  101.     p)
  102. (defun xyp-Pline (lst / lst pt)
  103. (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst))'(70 . 129))
  104.       (mapcar '(lambda (pt)(cons 10 pt)) lst ))
  105.   ) (vl-cmdf "_.region" (entlast) "") (entlast)
  106. )
  107. ;;改改更贱康
  108. (defun temp (pa pb p0 p1 p2 / MAT:vxv {vp} {v} a b)
  109.   (defun MAT:vxv (u v)
  110.     (list
  111.       (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
  112.       (- (* (car v) (caddr u)) (* (car u) (caddr v)))
  113.       (- (* (car u) (cadr v)) (* (car v) (cadr u)))
  114.     )
  115.   )
  116.   (setq {vp} (MAT:vxv (mapcar '- p1 p0) (mapcar '- p2 p0)))
  117.   (setq {v} (mapcar '- pa pb))
  118.   (setq  a (apply '+
  119. (mapcar '(lambda (n m vp) (* (- n m) vp)) p0 pa {vp})
  120.   )
  121.   )
  122.   (setq b (apply '+ (mapcar '* {vp} {v})))
  123.   (if (equal b 0.0 1e-6)
  124.     nil
  125.     (mapcar '(lambda (m v) (+ m (* v (/ a b)))) pa {v})
  126.   )
  127. )
  128. (defun insertgc ( e / e)
  129.   (cdr(assoc 10(entget e)))  )

  130. (defun c:pdpj ( / podu p1 p2 ang pts ssa ii no en ptb pzx pts1 pzx1 x blc scale pt ptlst zpt)
  131.   
  132.   (setq blc (getint "\n请输入比例尺1:<500>"))
  133.   (if (= blc nil)(setq blc 500))
  134.   (setvar 'userr1 blc);设置比例尺
  135. (setq scale (* 0.001 blc));缩放比例
  136.   
  137.   (setq podu (getreal "\n请输入坡度1:(挖+填-)?"))
  138.   (setq p1 (insertgc(car(entsel "\n请选择坡顶或者坡脚:"))))
  139. (setq ang (getangle p1 "\n请指定顶或者坡脚哪个方向? "))
  140. (setq p2 (polar p1 ang 100))
  141.   (setq pts1 (list p1 (append (vl-remove (last p2)p2) (list(+ (last p1 )(/ 100  podu ))))  ))
  142.   ;(print pts1)
  143.   (setq pts (list (vl-remove (last p1)p1) p2))
  144.   (vl-cmdf "zoom" "e")
  145. (setq ssa (ssget "f" pts'((0 . "POLYLINE") (8 . "sjw"))))
  146. ;(sssetfirst nil ssa)
  147. (setq ii   0  no  0)
  148.                   (repeat (sslength ssa)
  149.                        (setq en (ssname ssa ii)
  150.                             ptb (plinexy en)
  151.            ;demj (vlax-curve-getArea  (vlax-ename->vla-object en))
  152.           pzx (append pzx (list ptb))

  153.            ii  (1+ ii)  )                  
  154.                   )

  155.      

  156.   ;(setvar "osmode"16384)
  157. (foreach x pzx
  158.   
  159.   (setq pzx1 (temp (car pts1) (cadr pts1) (car x) (cadr x)(caddr x)   ))
  160. (if (and (/= pzx1 nil)
  161.     (>= (poinpl (mapcar '(lambda (b)  (vl-remove (last b)b)  )x) (vl-remove (last pzx1)pzx1)  )0)  )
  162.   (progn (print pzx1)(gxl-cs:gcd pzx1 (last pzx1) scale))
  163.   )

  164.   )
  165.   
  166.   
  167.       )


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1明经币 +3 金钱 +30 收起 理由
yfy2003 + 3 + 30 很给力!

查看全部评分

 楼主| 发表于 2016-10-27 22:42 | 显示全部楼层
三角网符合地形 坡顶坡脚位置才准确

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2016-10-28 14:41 | 显示全部楼层
你好    请问如何使用   
发表于 2016-10-29 16:53 来自手机 | 显示全部楼层
请问楼主,如何使用
发表于 2016-10-29 18:56 | 显示全部楼层
首先,三角网是用什么生成 的?
发表于 2016-10-30 20:51 来自手机 | 显示全部楼层
请问楼主,如何使用
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 21:27 , Processed in 0.220978 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表