2. ;==========================================================立面;
  3. ;-----------------------;
  4. ;  画立面窗  ;
  5. ;-----------------------;
  6. ;  模拟显示数字  ;
  7. ;-----------------------;
  8. (defun feng:num:grvecs ( li / num n temp str po )
  9.   (setq num '(("1" (150 0 0) (150 300 0))
  10.         ("2" (150 0 0) (0 0 0) (0 0 0) (0 150 0) (0 150 0) (150 150 0) (150 150 0) (150 300 0) (150 300 0) (0 300 0))
  11.         ("3" (0 0 0) (150 0 0) (150 0 0) (150 150 0) (150 150 0) (0 150 0) (150 150 0) (150 300 0) (150 300 0) (0 300 0))
  12.         ("4" (150 0 0) (150 150 0) (150 150 0) (150 300 0) (150 150 0) (0 150 0) (0 150 0) (0 300 0))
  13.         ("5" (0 0 0) (150 0 0) (150 0 0) (150 150 0) (150 150 0) (0 150 0) (0 150 0) (0 300 0) (0 300 0) (150 300 0))
  14.         ("6" (150 300 0) (0 300 0) (0 300 0) (0 0 0) (0 0 0) (150 0 0) (150 0 0) (150 150 0) (150 150 0) (0 150 0))
  15.         ("7" (150 0 0) (150 300 0) (150 300 0) (0 300 0))
  16.         ("8" (0 0 0) (150 0 0) (150 0 0) (150 300 0) (150 300 0) (0 300 0) (0 300 0) (0 0 0) (0 150 0) (150 150 0))
  17.         ("9" (0 0 0) (150 0 0) (150 0 0) (150 300 0) (150 300 0) (0 300 0) (0 300 0) (0 150 0) (0 150 0) (150 150 0))
  18.         ("0" (0 0 0) (150 0 0) (150 0 0) (150 300 0) (150 300 0) (0 300 0) (0 300 0) (0 0 0))
  19.         ("." (60 0 0) (90 0 0) (90 0 0) (90 30 0) (90 30 0) (60 30 0) (60 30 0) (60 0 0))
  20.         ("-" (0 150 0) (150 150 0))
  21.         )
  22.   po (last li)
  23.   li (car li)
  24.   str (substr (setq str (apply 'strcat (MAPCAR '(LAMBDA (x) (strcat x "-")) li))) 1 (1- (strlen str)))
  25.   n 0
  26.   )
  27.   (while (<= n (strlen str))
  28.     (setq temp (substr str (setq n (1+ n)) 1)
  29.     po (MAPCAR '+ po '(250 0 0))
  30.     )
  31.     (GRVECS (cons 1 (MAPCAR '(LAMBDA (x) (MAPCAR '+ x po)) (cdr (assoc temp num)))))
  32.     )
  33.   )
  34. ;-----------------------;
  35. ;  画矩形框  ;
  36. ;-----------------------;
  37. (defun feng:window:rec ( ms p1 / p2 gr l1 l2 temp1 temp2 li grvli tt )
  38.   (while (/= (car (setq gr (grread t 4 2))) 3)
  39.     (cond
  40.       ((or (= (cadr gr) 84) (= (cadr gr) 116))
  41.        (if tt (setq tt nil) (setq tt t))
  42.        )
  43.       ((= (car gr) 5)
  44.        (progn
  45.    (redraw)
  46.    (setq p2 (MAPCAR '(LAMBDA (x y) (+ x (* (fix (/ (- y x) (if tt 50 100))) (if tt 50.0 100.0)))) p1 (cadr gr))
  47.          l1 (if (null tt)
  48.         (feng:window:rec:temp (list (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)) 0)
  49.             (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2)) 0)
  50.             )
  51.           )
  52.         (feng:window:rec:temp (list (list (min (- (* (car p1) 2) (car p2)) (car p2)) (min (cadr p1) (cadr p2)) 0)
  53.             (list (max (- (* (car p1) 2) (car p2)) (car p2)) (max (cadr p1) (cadr p2)) 0)
  54.             )
  55.           )
  56.         )
  57.          l2 (feng:window:rec:temp (MAPCAR '(LAMBDA (x y) (MAPCAR '+ x y)) (list (car l1) (caddr l1)) '((50 50 0) (-50 -50 0))))
  58.          temp (cdr (REVERSE (MAPCAR '(LAMBDA (x y) (abs (- y x))) (car l1) (caddr l1))))
  59.          )
  60.    (GRVECS (cons 1 (REVERSE (cons (car l1) (REVERSE (cdr (apply 'append (MAPCAR '(LAMBDA (x) (list x x)) l1))))))))
  61.    (GRVECS (cons 2 (REVERSE (cons (car l2) (REVERSE (cdr (apply 'append (MAPCAR '(LAMBDA (x) (list x x)) l2))))))))
  62.    (feng:num:grvecs (list (REVERSE (cons (rtos (/ (apply '* temp) 1000000) 2 2) (MAPCAR '(LAMBDA (z) (rtos z 2 0)) temp))) (cadr gr)))
  63.    )
  64.        )
  65.       )
  66.     )
  67.   (redraw)
  68.   (list (list (feng:window:addobject ms l1) (feng:window:addobject ms l2)) (list l1 l2))
  69.   )
  70. (defun feng:window:rec:temp ( li / p1 p2 )
  71.   (list (setq p1 (car li))
  72.   (list (car (setq p2 (cadr li))) (cadr p1) 0)
  73.   p2
  74.   (list (car p1) (cadr p2) 0)
  75.   )
  76.   )
  77. (defun feng:window:addobject ( ms li / pont )
  78.   (setq li (apply 'append (MAPCAR '(LAMBDA (x) (trans x 1 0)) (REVERSE (cons (car li) (REVERSE li)))))
  79.   pont (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length li))))
  80.   )
  81.   (vlax-safearray-fill pont li)
  82.   (vla-AddPolyline ms pont)
  83.   )
  84. (defun feng:window:lz1 ( li po ms / lw hi gr num grli nn n )
  85.   (setq lw (REVERSE (cdr (REVERSE (MAPCAR '(LAMBDA (x y) (abs (- y x))) (car (car li)) (caddr (car li))))))
  86.   hi (if (< (cadr lw) 1500) (setq hi 0) (setq hi (* (fix (/ (cadr lw) 300)) 100)))
  87.   num (* (1+ (fix (/ (car lw) 2000))) 2)
  88.   li (car li)
  89.   )
  90.   (princ "\n调整亮子高度 w->减小 s->增大，调整窗的扇数 a->减少 d->增加...")
  91.   (while (/= (car (setq gr (grread t 4 2))) 3)
  92.     (cond
  93.       ((or (= (cadr gr) 65) (= (cadr gr) 97)) (if (<= num 2) (setq num 1) (setq num (- num 2))))
  94.       ((or (= (cadr gr) 100) (= (cadr gr) 68)) (if (= num 1) (setq num 2) (setq num (+ num 2))))
  95.       ((or (= (cadr gr) 119) (= (cadr gr) 87)) (if (<= hi 100) (setq hi 0) (setq hi (- hi 100))))
  96.       ((or (= (cadr gr) 115) (= (cadr gr) 83)) (if (>= hi (- (cadr lw) 100)) (setq hi 0) (setq hi (+ hi 100))))
  97.       ((= (car gr) 5) (setq po (cadr gr)))
  98.       )
  99.     (if (/= hi 0) (setq grli (list (list (MAPCAR '+ (last li) (list 50 (- hi) 0)) (MAPCAR '+ (caddr li) (list -50 (- hi) 0))))) (setq grli nil))
  100.     (setq nn (/ (car lw) num))
  101.     (repeat (setq n (1- num))
  102.       (if (= (rem n 2) 0)
  103.   (setq grli (cons (list (MAPCAR '+ (car li) (list (* nn n) 50 0)) (MAPCAR '+ (last li) (list (* nn n) -50 0))) grli))
  104.   (setq grli (cons (list (MAPCAR '+ (car li) (list (* nn n) 50 0)) (MAPCAR '+ (last li) (list (* nn n) (if (= hi 0) -50 (- hi)) 0))) grli))
  105.   )
  106.       (setq n (1- n))
  107.       )
  108.     (redraw)
  109.     (MAPCAR '(LAMBDA (x) (GRVECS (cons 2 x))) grli)
  110.     (feng:num:grvecs (list (MAPCAR '(LAMBDA (x) (rtos x 2 0)) (REVERSE (cons hi (cons nn (cons num (REVERSE lw)))))) po ))
  111.     )
  112.   (redraw)
  113.   (MAPCAR '(LAMBDA (x) (vla-addline ms (vlax-3d-point (trans (car x) 1 0)) (vlax-3d-point (trans (cadr x) 1 0)))) grli)
  114.   )
  115. (defun c:gg ( / doc ms p1 li temp l2 *ERROR* objli )
  116.   (defun *ERROR* ( msg )
  117.     (if li (MAPCAR 'vla-Erase (car li)))
  118.     (if objli (MAPCAR 'vla-Erase objli))
  119.     (redraw)
  120.     )
  121.   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
  122.   ms (vla-get-ModelSpace doc)
  123.   p1 (getpoint "\n请选择一个角点:")
  124.   li (feng:window:rec ms p1)
  125.   )
  126.   (if (null (TBLSEARCH "layer" "feng-el-window")) (vla-put-color (vla-add (vla-get-layers doc) "feng-el-window") 3))
  127.   (MAPCAR '(LAMBDA (x) (vla-put-layer x "feng-el-window")) (car li))
  128.   (MAPCAR '(LAMBDA (x) (vla-put-layer x "feng-el-window") (vla-put-color x 2)) (setq objli (feng:window:lz1 (cadr li) p1 ms)))
  129.   (princ)
  130.   )

俺不会做动态演示，有兴趣的自己试

网友答:
黑洞—杜明智 发表于 2025-9-21 14:33
当年就写出这么优秀的东西，现在应该站在年轻人身后看他们一笔一笔的画干着急了吧。

不是干着急，是狂吐血

网友答:
zmzk 发表于 2024-2-21 19:59
明经里真是 藏龙卧虎，2012年 就编出 如此 不得了的程序，佩服！

太久没再写这些东西，都快看不懂自己写的是啥意思了。哈哈。。。

网友答:
feng582304 发表于 2024-5-10 03:52
太久没再写这些东西，都快看不懂自己写的是啥意思了。哈哈。。。

应该是现在用不到了吧

网友答: 不错，来个图片


网友答:

网友答: 这程序怎么执行啊？

网友答: 不好意思 没注意看……  好东西顶起

网友答: 牛人真多，俺要好好学习一下！

网友答: 程序是写得好，实用性方面可能要差些

网友答: 很好顶上………

网友答: 很好的学习资料

网友答: 楼主的程序真好

能不能与来一个动态画剖切符号的啊
  • 上一篇：[原创]批量打印程序2.9.1版（源代码）（重新上传
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025