明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2606|回复: 13

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

[复制链接]
发表于 2015-9-16 21:17 | 显示全部楼层 |阅读模式
随机高程--明经论坛各位大神函数,感谢
  1. (defun get_inpoint (blockname)
  2.   (setq in_point(cdr (assoc 10 (entget blockname))))
  3.   in_point
  4. )

  5. ;;;by Gu_xl
  6. (defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
  7.   (setvar "CMDECHO" 0)
  8.   (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")
  9.   (if height
  10.     (setq height (rtos height 2 3));3为高程注记位数
  11.     (setq height "")
  12.   )
  13.   (regapp "SOUTH")
  14.   
  15.   ;;;检查字体 "HZ" 是否存在
  16.   (if (not (tblobjname "style" "HZ"))
  17.     (command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
  18.   )
  19.   ;;;检查是否存在高程点图块定义
  20.   (if (not (tblobjname "block" "GC200"))
  21.     (progn
  22.       (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
  23.       (setq obj
  24.         (vla-AddPolyline
  25.            blkdef
  26.            (vlax-make-variant
  27.               (vlax-safearray-fill
  28.                  (vlax-make-safearray vlax-vbdouble (cons 0 5))
  29.                  '(-0.2 0 0 0.2 0 0)
  30.               )
  31.            )
  32.         )
  33.       )
  34.       (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
  35.       (vla-put-Closed obj :vlax-true)
  36.       (vla-put-ConstantWidth obj 0.4)
  37.     )
  38.   )
  39.   ;;;插入块
  40.   (entmake (list
  41.              '(0 . "INSERT")
  42.              '(100 . "AcDbEntity")
  43.              '(100 . "AcDbBlockReference")
  44.              '(66 . 1);;;属性跟随标志,1跟随,0不跟随
  45.               (cons 2 "GC200")
  46.               (cons 10 inspt)
  47.               (cons 41 scale)
  48.               (cons 42 scale)
  49.               (cons 43 scale)
  50.               (list -3 '("SOUTH" (1000 . "202101")))
  51.            )
  52.   )
  53.   ;;;插入属性
  54.   (entmake (list
  55.              '(0 . "ATTRIB")
  56.              '(100 . "AcDbEntity")
  57.              '(100 . "AcDbText")
  58.               (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
  59.               (cons 40 (* 2.0 scale))
  60.               (cons 50 0)
  61.               (cons 41 0.8)
  62.               (cons 51 0)
  63.               (cons 1 height)
  64.               (cons 7 "HZ")
  65.        (cons 62 1)
  66.               (cons 72 0)
  67.               (cons 11 pt)
  68.               '(100 . "AcDbAttribute")
  69.               (cons 2 "height")
  70.               (cons 70  0)
  71.               (cons 74 2)
  72.            )
  73.    )
  74.    ;;;结束标志
  75.    (entmake '((0 . "SEQEND")))
  76.    (princ)
  77. )


  78. (defun c:t123t (/ a b c n i num rndlst rndnumlst)
  79.   (vl-load-com)
  80.   (defun rnd (rMin rMax);_ Get a random value,Author: aeo
  81.     (vla-eval (vlax-get-acad-object)
  82.               "Randomize"
  83.     );_add randomize by Xran
  84.     (vla-eval (vlax-get-acad-object)
  85.               "ThisDrawing.setVariable "USERR5" ,CDbl(Rnd())"
  86.     )
  87.     (+ rMin (* (getvar "userr5") (- rMax rMin)))
  88.   )
  89.   (if (and (setq a (getint "\n随机数下限:"))
  90.            (setq b (getint "\n随机数上限:"))
  91.            (setq c (getint "\n随机数个数:"))
  92.            (setq n (getint "\n随机数最多重复次数:"))
  93.            (setq i 0)
  94.       )
  95.     (while (< i c)
  96.       (setq d (fix (rnd a b)))
  97.       (if (assoc d rndlst)
  98.         (progn
  99.           (setq num (cdr (assoc d rndlst)))
  100.           (if (< num n)
  101.             (setq rndlst (subst (cons d (1+ num)) (assoc d rndlst) rndlst)
  102.                   i         (1+ i)
  103.                   rndnumlst (append rndnumlst (list d))
  104.             )
  105.           )
  106.         )
  107.         (setq rndlst (append rndlst (list (cons d 1)))
  108.               rndnumlst (append rndnumlst (list d))
  109.               i             (1+ i)
  110.         )
  111.       )
  112.     )
  113.   )
  114.   rndnumlst
  115. )


  116. (defun RandList        (MinNum MaxNum Num n / co re x y RetList)
  117.   (defun randnum (/ modulus multiplier increment random)
  118.     (if        (not seed)
  119.       (setq seed (getvar "DATE"))
  120.     )
  121.     (setq modulus    65536
  122.           multiplier 25173
  123.           increment  13849
  124.           seed             (rem (+ (* multiplier seed) increment) modulus)
  125.           random     (/ seed modulus)
  126.           random     (fix (+ MinNum (* (- MaxNum MinNum -1) random)))
  127.     )
  128.   )
  129.   (setq        co 0
  130.         re 1
  131.   )
  132.   (while (< co Num)
  133.     (setq y  (car RetList)
  134.           co (1+ co)
  135.     )
  136.     (if        (>= re n)
  137.       (while (= (setq x (randnum)) y))
  138.       (if (= (setq x (randnum)) y)
  139.         (setq re (1+ re))
  140.         (setq re 1)
  141.       )
  142.     )
  143.     (setq RetList (cons x RetList))
  144.   )
  145.   (reverse RetList)
  146. )
  147. ;;;;;;;;;;;;;;;;;;;;
  148. (defun f (a b n i / l r Rani)
  149.   (defun Rani (a b / tmp)
  150.     (if        (not *Seed*)
  151.       (setq *Seed* (- (setq tmp (getvar "DATE")) (fix tmp)))
  152.     )
  153.     (+ a
  154.        (fix (* (- b a)
  155.                (setq
  156.                  *Seed*        (- (setq
  157.                              tmp (/ (* *Seed* 1000000000 663608941)
  158.                                     1000000000.0
  159.                                  )
  160.                            )
  161.                            (fix tmp)
  162.                         )
  163.                )
  164.             )
  165.        )
  166.     )
  167.   )
  168.   (cond
  169.     ((or
  170.        (and (> (rem n (1+ (- b a))) 0)
  171.             (< i (1+ (/ n (1+ (- b a)))))
  172.        )
  173.        (and (= (rem n (1+ (- b a))) 0)
  174.             (< i (/ n (1+ (- b a))))
  175.        )
  176.      )
  177.      (prompt "\n没有满足要求的结果")
  178.     )
  179.     ((and (= (rem n (1+ (- b a))) 0)
  180.           (= i (/ n (1+ (- b a))))
  181.      )
  182.      (repeat i
  183.        (setq l (cons a l))
  184.      )
  185.      (while (< a b)
  186.        (setq a (1+ a))
  187.        (repeat i
  188.          (setq l (cons a l))
  189.        )
  190.      )
  191.      (reverse l)
  192.     )
  193.     (t
  194.      (while (< (length l) n)
  195.        (setq r (Rani a b))
  196.        (if (< (- (length l) (length (vl-remove r l))) i)
  197.          (setq l (cons r l))
  198.        )
  199.      )
  200.      (reverse l)
  201.     )
  202.   )
  203. )
  204. ;;测试: (f 1 100 40 1)
  205. ;;;;;;;;;;;;;;;;;;;;;;;


  206. (defun c:sjgc (   / a b c n i xsws ss  shuijishu blc scale ent ent1)

  207. (vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
  208.      (setq blc (getint "\n请输入比例尺1:<500>"))
  209.   (if (= blc nil)(setq blc 500))
  210.   (setvar 'userr1 blc);设置比例尺
  211. (setq scale (* 0.001 blc));缩放比例
  212. (setq ss (ssget '((0 . "insert") (2 . "gc200"))))

  213. (setq a (getreal "\n随机数下限:"))
  214.            (setq b (getreal "\n随机数上限:"))
  215.            ;(setq c (getreal "\n随机数个数:"))
  216.            (setq n (getint "\n随机数最多重复次数:"))
  217.            
  218.       

  219. (command "_.units" "2" "8" "1" "8"  "0" "n")
  220. (setvar "dimzin" 8)
  221. (setq xsws (max (length(cdr(member 46(vl-string->list(rtos a)))))  (length(cdr(member 46(vl-string->list(rtos b)))))
  222. ) )

  223. (setq shuijishu (RandList  (* a (expt 10 xsws)) (* b (expt 10 xsws))  (sslength ss) n) )
  224.   (setvar "dimzin" 0)
  225. (setq i 0)
  226. (repeat (sslength ss)
  227. (setq ent (get_inpoint (ssname ss i)))
  228. (setq ent1 (list (car ent)(cadr ent) (/ (nth i shuijishu) (atof(rtos(expt 10 xsws) 2 xsws)) )))
  229.   (gxl-cs:gcd ent1 (/ (nth i shuijishu) (atof(rtos(expt 10 xsws) 2 xsws)) ) scale)
  230.   (setq i (1+ i))
  231.   )
  232.   (command "erase" ss "")



  233.       )

本帖子中包含更多资源

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

x

评分

参与人数 1明经币 +1 收起 理由
tryhi + 1

查看全部评分

 楼主| 发表于 2020-11-17 21:02 | 显示全部楼层
  1. ;;框选范围内交点插入图块  By Gu_xl 2011.04

  2. ;;;计算曲线交点

  3. (defun Curveinters (en1 en2 / pl pts)

  4.   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))

  5.   (while pl

  6.     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))

  7.    pl (cdr (cdr (cdr pl)))

  8.    )

  9.     )

  10. pts

  11.   )

  12. ;;;曲线选择集交点

  13. (defun ssinters (ss / pts en1 en2)

  14.   (while (> (sslength ss) 1)

  15.     (setq en1 (ssname ss 0))

  16.     (ssdel en1 ss)

  17.     (setq n (sslength ss))

  18.     (repeat n

  19.       (setq en2 (ssname ss (setq n (1- n))))

  20.       (setq pts (append pts (Curveinters en1 en2)))

  21.       )

  22.     )

  23.   pts

  24.   )





  25. ;;;实例: 按选择范围框内插入图块

  26. (defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho blockname )

  27.   (setq os (getvar "osmode"))

  28.   (setq cmdecho (getvar "cmdecho"))

  29.   (setvar "osmode" 0)

  30.   (setvar "cmdecho" 0)

  31.   (setq blockname (getstring  "\n插入块名称:"))

  32.   (if (null d) (setq d 1.))

  33.   (while (and

  34.            (setq p1 (getpoint "\n选择插入范围左下角:"))

  35.            (setq p2 (GETCORNER p1 "\n选择插入范围左下角:"))

  36.            )

  37.     (setq minX (apply 'min (mapcar 'car (list p1 p2)))

  38.           minY (apply 'min (mapcar 'cadr (list p1 p2)))

  39.           maxX (apply 'max (mapcar 'car (list p1 p2)))

  40.           maxY (apply 'max (mapcar 'cadr (list p1 p2)))

  41.           )

  42.     (grvecs (list 1 (list minx miny) (list maxx miny)

  43.                   1 (list maxx miny) (list maxx maxy)

  44.                   1 (list maxx maxy) (list minx maxy)

  45.                   1 (list minx maxy) (list minx miny)

  46.                   )

  47.             )

  48.     (setq ss (ssget "c" p1 p2 '((0 . "*line"))))

  49.     (if ss

  50.       (progn

  51.         (setq pts (ssinters ss))

  52.         (if pts

  53.           (foreach pt pts

  54.             (if (and (>= maxX (car pt) minX)

  55.                      (>= maxY (cadr pt) minY)

  56.                      )

  57.               ;;插入图块

  58.               (command "insert" blockname "_non" pt 1 1 0)

  59.               )

  60.             )

  61.           )

  62.         )

  63.       )

  64.     (princ "\n ***回车键结束***")

  65.     )

  66. (setvar "osmode" os)

  67.   (setvar "cmdecho" cmdecho)

  68.   (princ)

  69.   )

发表于 2015-9-16 22:03 | 显示全部楼层
作用是?作假么
回复 支持 1 反对 0

使用道具 举报

发表于 2020-4-23 21:19 | 显示全部楼层

应该是为了图面更好看
发表于 2015-9-17 13:00 | 显示全部楼层
我也是这个疑问,是用来作假的吗?
高程【elevation】指的是某点沿铅垂线方向到绝对基面的距离,称绝对高程,简称高程。
随机高程?好像都没有这个概念,请问楼主这个是什么意思?
发表于 2015-9-29 17:58 | 显示全部楼层
大神,支持!值得学习!
发表于 2015-10-1 10:50 | 显示全部楼层
估计用得着,先下载看看
发表于 2015-12-27 11:35 | 显示全部楼层
同步学习中…………
发表于 2015-12-28 19:55 | 显示全部楼层
谢谢…………
发表于 2017-10-15 13:51 | 显示全部楼层
没看懂什么用途
发表于 2017-10-15 15:45 | 显示全部楼层
本帖最后由 lifuq1979 于 2017-10-15 15:47 编辑

--------------------
发表于 2020-4-9 18:03 | 显示全部楼层
我用这个怎么报错啊
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-28 18:29 , Processed in 0.286791 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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