根据正确三角网计算坡顶或者坡脚位置
;;;by Gu_xl(defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
(regapp "SOUTH")
(setvar "CMDECHO" 0)
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")
(if height
(setq height (rtos height 2 3));3为高程注记位数
(setq height "")
)
(regapp "SOUTH")
;;;检查字体 "HZ" 是否存在
(if (not (tblobjname "style" "宋体"))
;(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
(command "style" "宋体" "" 0 1 0 "" "" "")
)
;;;检查是否存在高程点图块定义
(if (not (tblobjname "block" "GC200"))
(progn
(setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
(setq obj
(vla-AddPolyline
blkdef
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 5))
'(-0.2 0 0 0.2 0 0)
)
)
)
)
(vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
(vla-put-Closed obj :vlax-true)
(vla-put-ConstantWidth obj 0.4)
)
)
;;;插入块
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
(list -3 '("SOUTH" (1000 . "202101")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
(cons 40 (* 2.0 scale))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "宋体")
(cons 62 3)
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun PoInPl(pt p / n i va ang);;该过程由 StEf44604813提供，本人只是把输出由原来的t,nil改为了-1,0,1
(setq n(length pt)
pt(append pt(list(car pt)))i 0 ang 0)
(while(< i n)
(setq va(-(angle p(nth i pt))(angle p(nth(1+ i)pt))))
(if (<(abs(-(abs va)pi))0.000001)(setq ang 2 i n)
(progn(cond((> va pi)(setq va (- va pi)))
((< va (* -1 pi))(setq va (+ va pi))))
(setq ang(+ ang va)i(1+ i)))))
(if(= ang 2)0
(if(<(abs(-(abs ang) pi))0.000001)1 -1))
)
;defun
(defun plinexy(e / a q m p);;;LWPolyline,POLYLINE顶点,去掉完全重合点
(setq a(vlax-ename->vla-object e)
q(vlax-safearray->list(vlax-variant-value(vla-get-Coordinates a)))
m(vla-get-objectname a)a 0
m(if(= m"AcDb3dPolyline")3 2))
(repeat(/(length q)m)
(cond((= m 2)(setq p1(list(nth a q)(nth(+ a 1)q))))
((= m 3)(setq p1(list(nth a q)(nth(+ a 1)q)(nth(+ a 2)q)))))
(setq p(if (member p1 p)p (append p(list p1)))
a(+ a m)))
p)
(defun xyp-Pline (lst / lst pt)
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst))'(70 . 129))
(mapcar '(lambda (pt)(cons 10 pt)) lst ))
) (vl-cmdf "_.region" (entlast) "") (entlast)
)
;;改改更贱康
(defun temp (pa pb p0 p1 p2 / MAT:vxv {vp} {v} a b)
(defun MAT:vxv (u v)
(list
(- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
(- (* (car v) (caddr u)) (* (car u) (caddr v)))
(- (* (car u) (cadr v)) (* (car v) (cadr u)))
)
)
(setq {vp} (MAT:vxv (mapcar '- p1 p0) (mapcar '- p2 p0)))
(setq {v} (mapcar '- pa pb))
(setqa (apply '+
(mapcar '(lambda (n m vp) (* (- n m) vp)) p0 pa {vp})
)
)
(setq b (apply '+ (mapcar '* {vp} {v})))
(if (equal b 0.0 1e-6)
nil
(mapcar '(lambda (m v) (+ m (* v (/ a b)))) pa {v})
)
)
(defun insertgc ( e / e)
(cdr(assoc 10(entget e))))
(defun c:pdpj ( / podu p1 p2 ang pts ssa ii no en ptb pzx pts1 pzx1 x blc scale pt ptlst zpt)
(setq blc (getint "\n请输入比例尺1:<500>"))
(if (= blc nil)(setq blc 500))
(setvar 'userr1 blc);设置比例尺
(setq scale (* 0.001 blc));缩放比例
(setq podu (getreal "\n请输入坡度1：(挖+填-)?"))
(setq p1 (insertgc(car(entsel "\n请选择坡顶或者坡脚："))))
(setq ang (getangle p1 "\n请指定顶或者坡脚哪个方向? "))
(setq p2 (polar p1 ang 100))
(setq pts1 (list p1 (append (vl-remove (last p2)p2) (list(+ (last p1 )(/ 100podu ))))))
;(print pts1)
(setq pts (list (vl-remove (last p1)p1) p2))
(vl-cmdf "zoom" "e")
(setq ssa (ssget "f" pts'((0 . "POLYLINE") (8 . "sjw"))))
;(sssetfirst nil ssa)
(setq ii 0no0)
(repeat (sslength ssa)
(setq en (ssname ssa ii)
ptb (plinexy en)
;demj (vlax-curve-getArea(vlax-ename->vla-object en))
pzx (append pzx (list ptb))
ii(1+ ii))
)
;(setvar "osmode"16384)
(foreach x pzx
(setq pzx1 (temp (car pts1) (cadr pts1) (car x) (cadr x)(caddr x) ))
(if (and (/= pzx1 nil)
(>= (poinpl (mapcar '(lambda (b)(vl-remove (last b)b))x) (vl-remove (last pzx1)pzx1))0))
(progn (print pzx1)(gxl-cs:gcd pzx1 (last pzx1) scale))
)
)
)
三角网符合地形 坡顶坡脚位置才准确
你好 请问如何使用 请问楼主，如何使用 首先，三角网是用什么生成 的？ 请问楼主，如何使用
页:
[1]