随机坐标高程 73哥 GU版函数

树櫴希德 · 发表于 2015-9-18 20:44:08

随机坐标高程 73哥 GU版函数

;;;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 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 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)
(setq ent11 (car (entsel "\n请选择边界线：")))
(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)
(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 (list (/ xzb 1000) (/ yzb 1000) (/ (nth i shuijishu) 1000) ) )
(gxl-cs:gcd xinzb (/ (nth i shuijishu) 1000) scale)
(setq i (1+ i))
) )
)
)

;;;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 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) 
            (
       ) 
       (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 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) 
(setq ent11 (car (entsel "\n请选择边界线："))) 
(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) 
(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 (list (/ xzb 1000) (/ yzb 1000) (/ (nth i shuijishu) 1000)  )   ) 
   (gxl-cs:gcd  xinzb (/ (nth i shuijishu) 1000) scale) 
   (setq i (1+ i)) 
   ) ) 
   
 
 
   
  ) 
 
)

llsheng_73 · 发表于 2015-9-18 21:16:14

本帖最后由 llsheng_73 于 2015-9-18 21:26 编辑

看样子个数没有被保证，因为只生成了要求的100个数据，但在范围外的被排除了。。。
RandList按指定要求生成随机数表很强大。。。实际上你可以象高程数据一样先在把坐标数据生成了(重复次数限定为1)，可以让它生成的比实际需要的多，比如1.5倍甚至2倍，然后再一个个判断是否在指定多边形范围内，直到够了指定个数为止

树櫴希德 · 发表于 2015-9-18 21:31:23

llsheng_73 发表于 2015-9-18 21:16
看样子个数没有被保证，因为只生成了要求的100个数据，但在范围外的被排除了。。。
RandList按指定要求生成 ...

对个数没有被保证有些范围外被删除了

zzyong00 · 发表于 2015-9-18 22:17:27

是建随机地形图吗？

czb203 · 发表于 2021-6-27 23:05:45

使用出现：
命令:
没有满足要求的结果
没有满足要求的结果

求解！

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

随机坐标高程 73哥 GU版函数

本帖子中包含更多资源

评分

相关帖子