随机等高线加高程
本帖最后由 树櫴希德 于 2017-8-23 20:54 编辑<div class="blockcode"><blockquote>(defun lst-(l1 l2)
(vl-remove-if'(lambda(x)(member x l2))l1))
(defun deld(lst d / a b c)
(while(setq a(mapcar'+(car lst)'(0 0))
b(vl-remove-if'(lambda(x)(>(distance a x)d))(cdr lst))
lst(lst-(cdr lst)b))
(setq c(cons b c))
)
(apply'append c))
(defun gcpzx (pt ss / pt ss k pzx name pt pl p2 pzx1 kk Name1 pzx2 pzx3 gcc juli1 juli2 bz xgc xzb)
;(setq PT(getPOINT "\n请点击点："))
;(setq dgj(getreal "\n请输入等高距："))
;(setq ss (ssget '((0 . "POLYLINE") (8 . "DSX,DGX"))))
(if ss
(progn
(setq k -1)
(setq pl '())
(repeat (sslength ss)
(setq Name (ssname ss (setq k (1+ k))) )
(setq pzx(distance (vl-remove(last pt) pt)(vl-remove(last (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name) PT )) (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name) PT ))
))
(setq pl (append pl (list pzx)))
) (setq p2 (vl-sort pl '<))
);;;;
);;;;;;===========
(if ss
(progn
(setq kk -1)
(repeat (sslength ss)
(setq Name1 (ssname ss (setq kk (1+ kk))) )
(setq pzx1(distance (vl-remove(last pt) pt)(vl-remove(last (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name1) PT )) (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name1) PT ))
))
(cond
((equal (car p2) pzx1 0.001) (setq pzx2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name1) PT ))
)
((equal (cadr p2) pzx1 0.001) (setq pzx3 (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name1) PT ))
)
)
)
(setq gcc (- (last pzx2) (last pzx3)))
(setq juli1 (distance (vl-remove (last pzx2) pzx2) (vl-remove (last pzx3) pzx3) ))
(setq juli2 (distance (vl-remove (last pt) pt) (vl-remove (last pzx3) pzx3) ))
(setq bz (/ gcc juli1))
(setq xgc (+ (last pzx3)(* bz juli2) ))
(setq xzb (list (car pt) (cadr pt) xgc))
);;;;
);;;;;;===========
xzb
);;;;;;;----------------------------------
;;;by Gu_xl
(defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
(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" "HZ"))
(command "style" "HZ" "rs.shx,hztxt.shx" 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 "HZ")
(cons 62 1)
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 700)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;;;;;;;;;;;;;;;;;;
(defun RandList (a b n i / l r Rani)
(defun Rani (a b / tmp)
(if (not *Seed*)
(setq *Seed* (- (setq tmp (getvar "DATE")) (fix tmp)))
)
(+ a
(fix (* (- b a)
(setq
*Seed* (- (setq
tmp (/ (* *Seed* 1000000000 663608941)
1000000000.0
)
)
(fix tmp)
)
)
)
)
)
)
(cond
((or
(and (> (rem n (1+ (- b a))) 0)
(< i (1+ (/ n (1+ (- b a)))))
)
(and (= (rem n (1+ (- b a))) 0)
(< i (/ n (1+ (- b a))))
)
)
(prompt "\n没有满足要求的结果")
)
((and (= (rem n (1+ (- b a))) 0)
(= i (/ n (1+ (- b a))))
)
(repeat i
(setq l (cons a l))
)
(while (< a b)
(setq a (1+ a))
(repeat i
(setq l (cons a l))
)
)
(reverse l)
)
(t
(while (< (length l) n)
(setq r (Rani a b))
(if (< (- (length l) (length (vl-remove r l))) i)
(setq l (cons r l))
)
)
(reverse l)
)
)
)
;;测试: (f 1 100 40 1)
(defun rand(low top / a b)
(setq a(last(assoc(type low)'((int atoi)(real atof))))
b(+(*(- top low)(/(apply a(list(substr(rtos(getvar "cputicks"))8 3)))1000.))low)
b(if(equal a'atoi)(fix b)b))
)
;;;;;;;;;;;;;;;;;;;;;;;
(defun poinpl(p pt);;:点是否在指定点表内
(equal(abs(apply'+(mapcar'(lambda(x y)(rem(-(angle x p)(angle y p))pi))pt(cons(last pt)pt))))pi 1e-8))
(defun plinexy(e)
(mapcar'cdr(vl-remove-if'(lambda(x)(/=(car x)10))(entget e)))
)
(defun c:sjgcd ( / ent11 pts ptlst ptlst1 e1 e2 minzb maxzb blc scale a b c n shuijishu i xzb yzb xinzb pzx123 xx)
(setq ent11 (car (entsel "\n请选择边界线：")))
(prompt "\n请选择等高线:")
(setq ss (ssget '((0 . "POLYLINE") (8 . "DSX,DGX"))))
(setq pts (plinexy ent11))
;(setq zfu (poinpl (getpoint "\n.......") pts))
(setq ptlst (vl-sort pts
;以下根据y坐标对表排序
'(lambda (e1 e2)
(< (cadr e1) (cadr e2) )
) ) )
(setq ptlst1 (vl-sort pts
;以下根据x坐标对表排序
'(lambda (e1 e2)
(< (car e1) (car e2) )
) ) )
(setq minzb (list (car(car ptlst1))(cadr(car ptlst)) ) )
(setq maxzb (list (car(last ptlst1))(cadr(last ptlst)) ) )
;(command "rectangle" minzb maxzb)
(vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
(setq blc (getint "\n请输入比例尺1:<500>"))
(if (= blc nil)(setq blc 500))
(setvar 'userr1 blc);设置比例尺
(setq scale (* 0.001 blc));缩放比例
;(setq a (getreal "\n随机数下限(不要超过3位小数):"))
; (setq b (getreal "\n随机数上限(不要超过3位小数):"))
(setq c (getint "\n随机数个数:"))
(setq n (getint "\n随机数最多重复次数:"))
;(command "_.units" "2" "8" "1" "8""0" "n")
;(princ)
;(setvar "dimzin" 8)
;(setq shuijishu (RandList(* a (expt 10 3)) (* b (expt 10 3))c n) )
; (setvar "dimzin" 0)
(setq i 0)(setq pzx123 '())
(repeat c
(if (and (setq xzb (car(randlist (* (atof (rtos (car minzb)2 3 ) )1000) (* (atof (rtos (car maxzb)2 3 ) )1000)c n) ))
(setq yzb (car(randlist (* (atof (rtos (cadr minzb)2 3 ) )1000) (* (atof (rtos (cadr maxzb)2 3 ) )1000)c n) ))
(= (poinpl (list (/ xzb 1000) (/ yzb 1000) ) pts)T)
)
(progn
(setq xinzb (gcpzx (list (/ xzb 1000) (/ yzb 1000) 0.000) ss))
(setq pzx123 (append (list xinzb) pzx123))
(setq i (1+ i))
) )
)
(foreach xx (lst- pzx123 (deld pzx123 5.0000))
(gxl-cs:gcdxx (last xx) scale)
)
(princ)
)
我觉得不好，等高线还得依靠高程点，先后次序不能变，大多数情况下高程点不会丢失！ lizhigang.jin 发表于 2017-8-3 15:28
命令: (LOAD "C:/Users/Administrator/Desktop/新建文本文档.lsp") ; 错误: no
function definition: 不 ...
你这个我提我也遇到了，请问你解决了吗？ 命令: (LOAD "C:/Users/Administrator/Desktop/新建文本文档.lsp") ; 错误: no
function definition: 不要超过3位小数 赞个赞个，就是有一点，加出来的点，分布可以在优化一下 命令: (LOAD "C:/Users/Administrator/Desktop/新建文本文档.lsp") ; 错误: no
function definition: 不要超过3位小数 楼主又出山了
非常感谢！！{:1_1:}我需要高程值小数点后两位数，搞半天终于明白是RTOS这个函数 非常感谢，拷贝下来学习学习:lol 要随贴测试dwg文件 血司 发表于 2017-8-3 10:15
赞个赞个，就是有一点，加出来的点，分布可以在优化一下
怎么用的？我这边提示错误的