有一段时间没来，献上俺最近做的一个动态画立面窗的lsp

feng582304

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.   )

;==========================================================立面;<br /> ;-----------------------;<br /> ;  画立面窗  ;<br /> ;-----------------------;<br /> ;  模拟显示数字  ;<br /> ;-----------------------;<br /> (defun feng:num:grvecs ( li / num n temp str po )<br />   (setq num '(("1" (150 0 0) (150 300 0))<br />         ("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))<br />         ("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))<br />         ("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))<br />         ("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))<br />         ("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))<br />         ("7" (150 0 0) (150 300 0) (150 300 0) (0 300 0))<br />         ("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))<br />         ("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))<br />         ("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))<br />         ("." (60 0 0) (90 0 0) (90 0 0) (90 30 0) (90 30 0) (60 30 0) (60 30 0) (60 0 0))<br />         ("-" (0 150 0) (150 150 0))<br />         )<br />   po (last li)<br />   li (car li)<br />   str (substr (setq str (apply 'strcat (MAPCAR '(LAMBDA (x) (strcat x "-")) li))) 1 (1- (strlen str)))<br />   n 0<br />   )<br />   (while (<= n (strlen str))<br />     (setq temp (substr str (setq n (1+ n)) 1)<br />     po (MAPCAR '+ po '(250 0 0))<br />     )<br />     (GRVECS (cons 1 (MAPCAR '(LAMBDA (x) (MAPCAR '+ x po)) (cdr (assoc temp num)))))<br />     )<br />   )<br /> ;-----------------------;<br /> ;  画矩形框  ;<br /> ;-----------------------;<br /> (defun feng:window:rec ( ms p1 / p2 gr l1 l2 temp1 temp2 li grvli tt )<br />   (while (/= (car (setq gr (grread t 4 2))) 3)<br />     (cond<br />       ((or (= (cadr gr) 84) (= (cadr gr) 116))<br />        (if tt (setq tt nil) (setq tt t))<br />        )<br />       ((= (car gr) 5)<br />        (progn<br />    (redraw)<br />    (setq p2 (MAPCAR '(LAMBDA (x y) (+ x (* (fix (/ (- y x) (if tt 50 100))) (if tt 50.0 100.0)))) p1 (cadr gr))<br />          l1 (if (null tt)<br />         (feng:window:rec:temp (list (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2)) 0)<br />             (list (max (car p1) (car p2)) (max (cadr p1) (cadr p2)) 0)<br />             )<br />           )<br />         (feng:window:rec:temp (list (list (min (- (* (car p1) 2) (car p2)) (car p2)) (min (cadr p1) (cadr p2)) 0)<br />             (list (max (- (* (car p1) 2) (car p2)) (car p2)) (max (cadr p1) (cadr p2)) 0)<br />             )<br />           )<br />         )<br />          l2 (feng:window:rec:temp (MAPCAR '(LAMBDA (x y) (MAPCAR '+ x y)) (list (car l1) (caddr l1)) '((50 50 0) (-50 -50 0))))<br />          temp (cdr (REVERSE (MAPCAR '(LAMBDA (x y) (abs (- y x))) (car l1) (caddr l1))))<br />          )<br />    (GRVECS (cons 1 (REVERSE (cons (car l1) (REVERSE (cdr (apply 'append (MAPCAR '(LAMBDA (x) (list x x)) l1))))))))<br />    (GRVECS (cons 2 (REVERSE (cons (car l2) (REVERSE (cdr (apply 'append (MAPCAR '(LAMBDA (x) (list x x)) l2))))))))<br />    (feng:num:grvecs (list (REVERSE (cons (rtos (/ (apply '* temp) 1000000) 2 2) (MAPCAR '(LAMBDA (z) (rtos z 2 0)) temp))) (cadr gr)))<br />    )<br />        )<br />       )<br />     )<br />   (redraw)<br />   (list (list (feng:window:addobject ms l1) (feng:window:addobject ms l2)) (list l1 l2))<br />   )<br /> (defun feng:window:rec:temp ( li / p1 p2 )<br />   (list (setq p1 (car li))<br />   (list (car (setq p2 (cadr li))) (cadr p1) 0)<br />   p2<br />   (list (car p1) (cadr p2) 0)<br />   )<br />   )<br /> (defun feng:window:addobject ( ms li / pont )<br />   (setq li (apply 'append (MAPCAR '(LAMBDA (x) (trans x 1 0)) (REVERSE (cons (car li) (REVERSE li)))))<br />   pont (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length li))))<br />   )<br />   (vlax-safearray-fill pont li)<br />   (vla-AddPolyline ms pont)<br />   )<br /> (defun feng:window:lz1 ( li po ms / lw hi gr num grli nn n )<br />   (setq lw (REVERSE (cdr (REVERSE (MAPCAR '(LAMBDA (x y) (abs (- y x))) (car (car li)) (caddr (car li))))))<br />   hi (if (< (cadr lw) 1500) (setq hi 0) (setq hi (* (fix (/ (cadr lw) 300)) 100)))<br />   num (* (1+ (fix (/ (car lw) 2000))) 2)<br />   li (car li)<br />   )<br />   (princ "\n调整亮子高度 w->减小 s->增大，调整窗的扇数 a->减少 d->增加...")<br />   (while (/= (car (setq gr (grread t 4 2))) 3)<br />     (cond<br />       ((or (= (cadr gr) 65) (= (cadr gr) 97)) (if (<= num 2) (setq num 1) (setq num (- num 2))))<br />       ((or (= (cadr gr) 100) (= (cadr gr) 68)) (if (= num 1) (setq num 2) (setq num (+ num 2))))<br />       ((or (= (cadr gr) 119) (= (cadr gr) 87)) (if (<= hi 100) (setq hi 0) (setq hi (- hi 100))))<br />       ((or (= (cadr gr) 115) (= (cadr gr) 83)) (if (>= hi (- (cadr lw) 100)) (setq hi 0) (setq hi (+ hi 100))))<br />       ((= (car gr) 5) (setq po (cadr gr)))<br />       )<br />     (if (/= hi 0) (setq grli (list (list (MAPCAR '+ (last li) (list 50 (- hi) 0)) (MAPCAR '+ (caddr li) (list -50 (- hi) 0))))) (setq grli nil))<br />     (setq nn (/ (car lw) num))<br />     (repeat (setq n (1- num))<br />       (if (= (rem n 2) 0)<br />   (setq grli (cons (list (MAPCAR '+ (car li) (list (* nn n) 50 0)) (MAPCAR '+ (last li) (list (* nn n) -50 0))) grli))<br />   (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))<br />   )<br />       (setq n (1- n))<br />       )<br />     (redraw)<br />     (MAPCAR '(LAMBDA (x) (GRVECS (cons 2 x))) grli)<br />     (feng:num:grvecs (list (MAPCAR '(LAMBDA (x) (rtos x 2 0)) (REVERSE (cons hi (cons nn (cons num (REVERSE lw)))))) po ))<br />     )<br />   (redraw)<br />   (MAPCAR '(LAMBDA (x) (vla-addline ms (vlax-3d-point (trans (car x) 1 0)) (vlax-3d-point (trans (cadr x) 1 0)))) grli)<br />   )<br /> (defun c:gg ( / doc ms p1 li temp l2 *ERROR* objli )<br />   (defun *ERROR* ( msg )<br />     (if li (MAPCAR 'vla-Erase (car li)))<br />     (if objli (MAPCAR 'vla-Erase objli))<br />     (redraw)<br />     )<br />   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))<br />   ms (vla-get-ModelSpace doc)<br />   p1 (getpoint "\n请选择一个角点:")<br />   li (feng:window:rec ms p1)<br />   )<br />   (if (null (TBLSEARCH "layer" "feng-el-window")) (vla-put-color (vla-add (vla-get-layers doc) "feng-el-window") 3))<br />   (MAPCAR '(LAMBDA (x) (vla-put-layer x "feng-el-window")) (car li))<br />   (MAPCAR '(LAMBDA (x) (vla-put-layer x "feng-el-window") (vla-put-color x 2)) (setq objli (feng:window:lz1 (cadr li) p1 ms)))<br />   (princ)<br />   )

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

feng582304

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

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

loveu515

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

应该是现在用不到了吧

zmzk

明经里真是 藏龙卧虎，2012年 就编出 如此 不得了的程序，佩服！

52幕墙设计

不错，来个图片

杨如迁

328302216

这程序怎么执行啊？

328302216

不好意思 没注意看……  好东西顶起

六千棵橡树V

牛人真多，俺要好好学习一下！

luyu9635

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

flytoday

很好顶上………

tjuzkj

很好的学习资料

ynhh

楼主的程序真好

能不能与来一个动态画剖切符号的啊