随机高程--明经论坛各位大神函数，感谢

树櫴希德 · 发表于 2015-9-16 21:17:45

随机高程--明经论坛各位大神函数，感谢

(defun get_inpoint (blockname)
(setq in_point(cdr (assoc 10 (entget blockname))))
in_point
)
;;;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 70 0)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
(defun c:t123t (/ a b c n i num rndlst rndnumlst)
(vl-load-com)
(defun rnd (rMin rMax);_ Get a random value,Author: aeo
(vla-eval (vlax-get-acad-object)
"Randomize"
);_add randomize by Xran
(vla-eval (vlax-get-acad-object)
"ThisDrawing.setVariable "USERR5" ,CDbl(Rnd())"
)
(+ rMin (* (getvar "userr5") (- rMax rMin)))
)
(if (and (setq a (getint "\n随机数下限:"))
(setq b (getint "\n随机数上限:"))
(setq c (getint "\n随机数个数:"))
(setq n (getint "\n随机数最多重复次数:"))
(setq i 0)
)
(while (< i c)
(setq d (fix (rnd a b)))
(if (assoc d rndlst)
(progn
(setq num (cdr (assoc d rndlst)))
(if (< num n)
(setq rndlst (subst (cons d (1+ num)) (assoc d rndlst) rndlst)
i (1+ i)
rndnumlst (append rndnumlst (list d))
)
)
)
(setq rndlst (append rndlst (list (cons d 1)))
rndnumlst (append rndnumlst (list d))
i (1+ i)
)
)
)
)
rndnumlst
)
(defun RandList (MinNum MaxNum Num n / co re x y RetList)
(defun randnum (/ modulus multiplier increment random)
(if (not seed)
(setq seed (getvar "DATE"))
)
(setq modulus 65536
multiplier 25173
increment 13849
seed (rem (+ (* multiplier seed) increment) modulus)
random (/ seed modulus)
random (fix (+ MinNum (* (- MaxNum MinNum -1) random)))
)
)
(setq co 0
re 1
)
(while (< co Num)
(setq y (car RetList)
co (1+ co)
)
(if (>= re n)
(while (= (setq x (randnum)) y))
(if (= (setq x (randnum)) y)
(setq re (1+ re))
(setq re 1)
)
)
(setq RetList (cons x RetList))
)
(reverse RetList)
)
;;;;;;;;;;;;;;;;;;;;
(defun f (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 c:sjgc ( / a b c n i xsws ss shuijishu blc scale ent ent1)
(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 ss (ssget '((0 . "insert") (2 . "gc200"))))
(setq a (getreal "\n随机数下限:"))
(setq b (getreal "\n随机数上限:"))
;(setq c (getreal "\n随机数个数:"))
(setq n (getint "\n随机数最多重复次数:"))
(command "_.units" "2" "8" "1" "8" "0" "n")
(setvar "dimzin" 8)
(setq xsws (max (length(cdr(member 46(vl-string->list(rtos a))))) (length(cdr(member 46(vl-string->list(rtos b)))))
) )
(setq shuijishu (RandList (* a (expt 10 xsws)) (* b (expt 10 xsws)) (sslength ss) n) )
(setvar "dimzin" 0)
(setq i 0)
(repeat (sslength ss)
(setq ent (get_inpoint (ssname ss i)))
(setq ent1 (list (car ent)(cadr ent) (/ (nth i shuijishu) (atof(rtos(expt 10 xsws) 2 xsws)) )))
(gxl-cs:gcd ent1 (/ (nth i shuijishu) (atof(rtos(expt 10 xsws) 2 xsws)) ) scale)
(setq i (1+ i))
)
(command "erase" ss "")
)

(defun get_inpoint (blockname) 
  (setq in_point(cdr (assoc 10 (entget blockname)))) 
  in_point 
) 
 
;;;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 70  0) 
              (cons 74 2) 
           ) 
   ) 
   ;;;结束标志 
   (entmake '((0 . "SEQEND"))) 
   (princ) 
) 
 
 
(defun c:t123t (/ a b c n i num rndlst rndnumlst) 
  (vl-load-com) 
  (defun rnd (rMin rMax);_ Get a random value,Author: aeo 
    (vla-eval (vlax-get-acad-object) 
              "Randomize" 
    );_add randomize by Xran 
    (vla-eval (vlax-get-acad-object) 
              "ThisDrawing.setVariable "USERR5" ,CDbl(Rnd())" 
    ) 
    (+ rMin (* (getvar "userr5") (- rMax rMin))) 
  ) 
  (if (and (setq a (getint "\n随机数下限:")) 
           (setq b (getint "\n随机数上限:")) 
           (setq c (getint "\n随机数个数:")) 
           (setq n (getint "\n随机数最多重复次数:")) 
           (setq i 0) 
      ) 
    (while (
      (setq d (fix (rnd a b))) 
      (if (assoc d rndlst) 
        (progn 
          (setq num (cdr (assoc d rndlst))) 
          (if (< num n) 
            (setq rndlst (subst (cons d (1+ num)) (assoc d rndlst) rndlst) 
                  i         (1+ i) 
                  rndnumlst (append rndnumlst (list d)) 
            ) 
          ) 
        ) 
        (setq rndlst (append rndlst (list (cons d 1))) 
              rndnumlst (append rndnumlst (list d)) 
              i             (1+ i) 
        ) 
      ) 
    ) 
  ) 
  rndnumlst 
) 
 
 
(defun RandList        (MinNum MaxNum Num n / co re x y RetList) 
  (defun randnum (/ modulus multiplier increment random) 
    (if        (not seed) 
      (setq seed (getvar "DATE")) 
    ) 
    (setq modulus    65536 
          multiplier 25173 
          increment  13849 
          seed             (rem (+ (* multiplier seed) increment) modulus) 
          random     (/ seed modulus) 
          random     (fix (+ MinNum (* (- MaxNum MinNum -1) random))) 
    ) 
  ) 
  (setq        co 0 
        re 1 
  ) 
  (while (< co Num) 
    (setq y  (car RetList) 
          co (1+ co) 
    ) 
    (if        (>= re n) 
      (while (= (setq x (randnum)) y)) 
      (if (= (setq x (randnum)) y) 
        (setq re (1+ re)) 
        (setq re 1) 
      ) 
    ) 
    (setq RetList (cons x RetList)) 
  ) 
  (reverse RetList) 
) 
;;;;;;;;;;;;;;;;;;;; 
(defun f (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) 
            (
       ) 
       (and (= (rem n (1+ (- b a))) 0) 
            (
       ) 
     ) 
     (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 c:sjgc (   / a b c n i xsws ss  shuijishu blc scale ent ent1) 
 
(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 ss (ssget '((0 . "insert") (2 . "gc200")))) 
 
 (setq a (getreal "\n随机数下限:")) 
           (setq b (getreal "\n随机数上限:")) 
           ;(setq c (getreal "\n随机数个数:")) 
           (setq n (getint "\n随机数最多重复次数:")) 
            
       
 
(command "_.units" "2" "8" "1" "8"  "0" "n") 
(setvar "dimzin" 8) 
(setq xsws (max (length(cdr(member 46(vl-string->list(rtos a)))))  (length(cdr(member 46(vl-string->list(rtos b))))) 
) ) 
 
 (setq shuijishu (RandList  (* a (expt 10 xsws)) (* b (expt 10 xsws))  (sslength ss) n) ) 
  (setvar "dimzin" 0) 
(setq i 0) 
(repeat (sslength ss) 
(setq ent (get_inpoint (ssname ss i))) 
(setq ent1 (list (car ent)(cadr ent) (/ (nth i shuijishu) (atof(rtos(expt 10 xsws) 2 xsws)) ))) 
  (gxl-cs:gcd ent1 (/ (nth i shuijishu) (atof(rtos(expt 10 xsws) 2 xsws)) ) scale) 
  (setq i (1+ i)) 
  ) 
  (command "erase" ss "") 
 
 
 
      )

树櫴希德 · 发表于 2020-11-17 21:02:00

;;框选范围内交点插入图块 By Gu_xl 2011.04
;;;计算曲线交点
(defun Curveinters (en1 en2 / pl pts)
(setq pl (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
(while pl
(setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
pl (cdr (cdr (cdr pl)))
)
)
pts
)
;;;曲线选择集交点
(defun ssinters (ss / pts en1 en2)
(while (> (sslength ss) 1)
(setq en1 (ssname ss 0))
(ssdel en1 ss)
(setq n (sslength ss))
(repeat n
(setq en2 (ssname ss (setq n (1- n))))
(setq pts (append pts (Curveinters en1 en2)))
)
)
pts
)
;;;实例: 按选择范围框内插入图块
(defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho blockname )
(setq os (getvar "osmode"))
(setq cmdecho (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq blockname (getstring "\n插入块名称:"))
(if (null d) (setq d 1.))
(while (and
(setq p1 (getpoint "\n选择插入范围左下角："))
(setq p2 (GETCORNER p1 "\n选择插入范围左下角："))
)
(setq minX (apply 'min (mapcar 'car (list p1 p2)))
minY (apply 'min (mapcar 'cadr (list p1 p2)))
maxX (apply 'max (mapcar 'car (list p1 p2)))
maxY (apply 'max (mapcar 'cadr (list p1 p2)))
)
(grvecs (list 1 (list minx miny) (list maxx miny)
1 (list maxx miny) (list maxx maxy)
1 (list maxx maxy) (list minx maxy)
1 (list minx maxy) (list minx miny)
)
)
(setq ss (ssget "c" p1 p2 '((0 . "*line"))))
(if ss
(progn
(setq pts (ssinters ss))
(if pts
(foreach pt pts
(if (and (>= maxX (car pt) minX)
(>= maxY (cadr pt) minY)
)
;;插入图块
(command "insert" blockname "_non" pt 1 1 0)
)
)
)
)
)
(princ "\n ***回车键结束***")
)
(setvar "osmode" os)
(setvar "cmdecho" cmdecho)
(princ)
)

;;框选范围内交点插入图块  By Gu_xl 2011.04 
 
;;;计算曲线交点 
 
(defun Curveinters (en1 en2 / pl pts) 
 
  (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone)) 
 
  (while pl 
 
    (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl)))) 
 
   pl (cdr (cdr (cdr pl))) 
 
   ) 
 
    ) 
 
pts 
 
  ) 
 
;;;曲线选择集交点 
 
(defun ssinters (ss / pts en1 en2) 
 
  (while (> (sslength ss) 1) 
 
    (setq en1 (ssname ss 0)) 
 
    (ssdel en1 ss) 
 
    (setq n (sslength ss)) 
 
    (repeat n 
 
      (setq en2 (ssname ss (setq n (1- n)))) 
 
      (setq pts (append pts (Curveinters en1 en2))) 
 
      ) 
 
    ) 
 
  pts 
 
  ) 
 
 
 
 
 
;;;实例: 按选择范围框内插入图块 
 
(defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho blockname ) 
 
  (setq os (getvar "osmode")) 
 
  (setq cmdecho (getvar "cmdecho")) 
 
  (setvar "osmode" 0) 
 
  (setvar "cmdecho" 0) 
 
  (setq blockname (getstring  "\n插入块名称:")) 
 
  (if (null d) (setq d 1.)) 
 
  (while (and 
 
           (setq p1 (getpoint "\n选择插入范围左下角：")) 
 
           (setq p2 (GETCORNER p1 "\n选择插入范围左下角：")) 
 
           ) 
 
    (setq minX (apply 'min (mapcar 'car (list p1 p2))) 
 
          minY (apply 'min (mapcar 'cadr (list p1 p2))) 
 
          maxX (apply 'max (mapcar 'car (list p1 p2))) 
 
          maxY (apply 'max (mapcar 'cadr (list p1 p2))) 
 
          ) 
 
    (grvecs (list 1 (list minx miny) (list maxx miny) 
 
                  1 (list maxx miny) (list maxx maxy) 
 
                  1 (list maxx maxy) (list minx maxy) 
 
                  1 (list minx maxy) (list minx miny) 
 
                  ) 
 
            ) 
 
    (setq ss (ssget "c" p1 p2 '((0 . "*line")))) 
 
    (if ss 
 
      (progn 
 
        (setq pts (ssinters ss)) 
 
        (if pts 
 
          (foreach pt pts 
 
            (if (and (>= maxX (car pt) minX) 
 
                     (>= maxY (cadr pt) minY) 
 
                     ) 
 
              ;;插入图块 
 
              (command "insert" blockname "_non" pt 1 1 0) 
 
              ) 
 
            ) 
 
          ) 
 
        ) 
 
      ) 
 
    (princ "\n ***回车键结束***") 
 
    ) 
 
(setvar "osmode" os) 
 
  (setvar "cmdecho" cmdecho) 
 
  (princ) 
 
  )

spp_wall · 发表于 2015-9-16 22:03:36

作用是？作假么

跑了一下午 · 发表于 2020-4-23 21:19:57

spp_wall 发表于 2015-9-16 22:03
作用是？作假么

应该是为了图面更好看

429014673 · 发表于 2015-9-17 13:00:27

我也是这个疑问，是用来作假的吗？
高程【elevation】指的是某点沿铅垂线方向到绝对基面的距离，称绝对高程，简称高程。
随机高程？好像都没有这个概念，请问楼主这个是什么意思？

用户3314111597 · 发表于 2015-9-29 17:58:55

大神，支持！值得学习！

zbwei120 · 发表于 2015-10-1 10:50:54

估计用得着，先下载看看

知行ooo李肖坪 · 发表于 2015-12-27 11:35:06

同步学习中…………

知行ooo李肖坪 · 发表于 2015-12-28 19:55:25

谢谢…………

lifuq1979 · 发表于 2017-10-15 13:51:12

没看懂什么用途

lifuq1979 · 发表于 2017-10-15 15:45:20

本帖最后由 lifuq1979 于 2017-10-15 15:47 编辑

--------------------

不做伸手党 · 发表于 2020-4-9 18:03:22

我用这个怎么报错啊

账号		自动登录	找回密码
密码			注册

随机高程--明经论坛各位大神函数，感谢

本帖子中包含更多资源

评分

相关帖子