绣红旗

yjwht

很喜欢徐子尧版的《绣红旗》，用lisp编写了一段绣红旗代码，练习之作。还让豆包AI配诗一首，感觉还不错：


绣红旗志
铁窗难锁赤心昂，丝线穿针绣锦章。
五星闪耀红旗展，热血千秋映曙光。

2. (defun c:yt_f6 (/ v1 v2 v3) ;绘制红旗
   
3.   (setq v1 (getvar "osmode"))
   
4.   (setq v2 (getvar "cmdecho"))
   
5.   (setq v3 (getvar "blipmode"))
   
6.   (setq BB1 (getpoint "\n 指定红旗一个角点："))
   
7.   (setq BB2 (getpoint BB1 "\n 指定红旗对角角点："))
   
8.   (setq B1 (mapcar 'min BB1 BB2))
   
9.   (setq B2 (mapcar 'max BB1 BB2))
   
10.   (setvar "osmode" 0)
    
11.   (setvar "cmdecho" 0)
    
12.   (setvar "blipmode" 0)
    
13.   (setq i1 (min (/ (- (car B2) (car B1)) 30) (/ (- (cadr B2) (cadr B1)) 20)))
    
14.   (setq B2 (polar (polar B1 0 (* 30 i1)) (/ pi 2) (* 20 i1)))
    
15.   (command "layer" "m" "red_flag" "c" "1" """")
    
16.   (command "rectang" B1 B2)
    
17.   (setq A1 (polar (polar B1 0 (* 5 i1)) (/ pi 2) (* 15 i1)))
    
18.   (setq A2 (polar (polar B1 0 (* 10 i1)) (/ pi 2) (* 18 i1)))
    
19.   (setq A3 (polar (polar B1 0 (* 12 i1)) (/ pi 2) (* 16 i1)))
    
20.   (setq A4 (polar (polar B1 0 (* 12 i1)) (/ pi 2) (* 13 i1)))
    
21.   (setq A5 (polar (polar B1 0 (* 10 i1)) (/ pi 2) (* 11 i1)))
    
22.   (command "layer" "m" "yellow_flag" "c" "2" """")
    
23.   (setq  p1 (polar A1 (/ (* (+ (* 0 72) 90) pi) 180) (* 3.333 i1)))
    
24.   (setq  p2 (polar A1 (/ (* (+ (* 1 72) 90) pi) 180) (* 3.333 i1)))
    
25.   (setq  p3 (polar A1 (/ (* (+ (* 2 72) 90) pi) 180) (* 3.333 i1)))
    
26.   (setq  p4 (polar A1 (/ (* (+ (* 3 72) 90) pi) 180) (* 3.333 i1)))
    
27.   (setq  p5 (polar A1 (/ (* (+ (* 4 72) 90) pi) 180) (* 3.333 i1)))
    
28.   (command "pline" p1 (polar p1 (angle p1 p3) (* (distance p1 p3) 0.382))
    
29.       p2 (polar p2 (angle p2 p4) (* (distance p2 p4) 0.382))
    
30.       p3 (polar p3 (angle p3 p5) (* (distance p3 p5) 0.382))
    
31.       p4 (polar p4 (angle p4 p1) (* (distance p4 p1) 0.382))
    
32.       p5 (polar p5 (angle p5 p2) (* (distance p5 p2) 0.382))
    
33.       "c")
    
34.   (command "-hatch" "p" "solid" A1 "")
    
35.   (setq n 0)
    
36.   (while (< n 4)
    
37.   (setq A6 (nth n (list A2 A3 A4 A5)))
    
38.     (setq  p1 (polar A6 (+ (/ (* 0 72 pi) 180) (angle A6 A1)) i1))
    
39.     (setq  p2 (polar A6 (+ (/ (* 1 72 pi) 180) (angle A6 A1)) i1))
    
40.     (setq  p3 (polar A6 (+ (/ (* 2 72 pi) 180) (angle A6 A1)) i1))
    
41.     (setq  p4 (polar A6 (+ (/ (* 3 72 pi) 180) (angle A6 A1)) i1))
    
42.     (setq  p5 (polar A6 (+ (/ (* 4 72 pi) 180) (angle A6 A1)) i1))
    
43.     (command "pline" p1 (polar p1 (angle p1 p3) (* (distance p1 p3) 0.382))
    
44.       p2 (polar p2 (angle p2 p4) (* (distance p2 p4) 0.382))
    
45.       p3 (polar p3 (angle p3 p5) (* (distance p3 p5) 0.382))
    
46.       p4 (polar p4 (angle p4 p1) (* (distance p4 p1) 0.382))
    
47.       p5 (polar p5 (angle p5 p2) (* (distance p5 p2) 0.382))
    
48.       "c")
    
49.   (command "-hatch" "p" "solid" A6 "")
    
50.   (setq n (1+ n)))
    
51.   (command "layer" "m" "red_flag" "c" "1" """")
    
52.   (command "-hatch" "p" "solid" (polar (polar B1 0 i1) (/ pi 2) i1) "")
    
53.   (setvar "osmode" v1)
    
54.   (setvar "cmdecho" v2)
    
55.   (setvar "blipmode" v3)
    
56.   (princ)
    
57. )

(defun c:yt_f6 (/ v1 v2 v3) ;绘制红旗<br />   (setq v1 (getvar "osmode"))<br />   (setq v2 (getvar "cmdecho"))<br />   (setq v3 (getvar "blipmode"))<br />   (setq BB1 (getpoint "\n 指定红旗一个角点："))<br />   (setq BB2 (getpoint BB1 "\n 指定红旗对角角点："))<br />   (setq B1 (mapcar 'min BB1 BB2))<br />   (setq B2 (mapcar 'max BB1 BB2))<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setvar "blipmode" 0)<br />   (setq i1 (min (/ (- (car B2) (car B1)) 30) (/ (- (cadr B2) (cadr B1)) 20)))<br />   (setq B2 (polar (polar B1 0 (* 30 i1)) (/ pi 2) (* 20 i1)))<br />   (command "layer" "m" "red_flag" "c" "1" """")<br />   (command "rectang" B1 B2)<br />   (setq A1 (polar (polar B1 0 (* 5 i1)) (/ pi 2) (* 15 i1)))<br />   (setq A2 (polar (polar B1 0 (* 10 i1)) (/ pi 2) (* 18 i1)))<br />   (setq A3 (polar (polar B1 0 (* 12 i1)) (/ pi 2) (* 16 i1)))<br />   (setq A4 (polar (polar B1 0 (* 12 i1)) (/ pi 2) (* 13 i1)))<br />   (setq A5 (polar (polar B1 0 (* 10 i1)) (/ pi 2) (* 11 i1)))<br />   (command "layer" "m" "yellow_flag" "c" "2" """")<br />   (setq  p1 (polar A1 (/ (* (+ (* 0 72) 90) pi) 180) (* 3.333 i1)))<br />   (setq  p2 (polar A1 (/ (* (+ (* 1 72) 90) pi) 180) (* 3.333 i1)))<br />   (setq  p3 (polar A1 (/ (* (+ (* 2 72) 90) pi) 180) (* 3.333 i1)))<br />   (setq  p4 (polar A1 (/ (* (+ (* 3 72) 90) pi) 180) (* 3.333 i1)))<br />   (setq  p5 (polar A1 (/ (* (+ (* 4 72) 90) pi) 180) (* 3.333 i1)))<br />   (command "pline" p1 (polar p1 (angle p1 p3) (* (distance p1 p3) 0.382)) <br />       p2 (polar p2 (angle p2 p4) (* (distance p2 p4) 0.382)) <br />       p3 (polar p3 (angle p3 p5) (* (distance p3 p5) 0.382)) <br />       p4 (polar p4 (angle p4 p1) (* (distance p4 p1) 0.382)) <br />       p5 (polar p5 (angle p5 p2) (* (distance p5 p2) 0.382)) <br />       "c")<br />   (command "-hatch" "p" "solid" A1 "")<br />   (setq n 0)<br />   (while (< n 4)<br />   (setq A6 (nth n (list A2 A3 A4 A5)))<br />     (setq  p1 (polar A6 (+ (/ (* 0 72 pi) 180) (angle A6 A1)) i1))<br />     (setq  p2 (polar A6 (+ (/ (* 1 72 pi) 180) (angle A6 A1)) i1))<br />     (setq  p3 (polar A6 (+ (/ (* 2 72 pi) 180) (angle A6 A1)) i1))<br />     (setq  p4 (polar A6 (+ (/ (* 3 72 pi) 180) (angle A6 A1)) i1))<br />     (setq  p5 (polar A6 (+ (/ (* 4 72 pi) 180) (angle A6 A1)) i1))<br />     (command "pline" p1 (polar p1 (angle p1 p3) (* (distance p1 p3) 0.382)) <br />       p2 (polar p2 (angle p2 p4) (* (distance p2 p4) 0.382)) <br />       p3 (polar p3 (angle p3 p5) (* (distance p3 p5) 0.382)) <br />       p4 (polar p4 (angle p4 p1) (* (distance p4 p1) 0.382)) <br />       p5 (polar p5 (angle p5 p2) (* (distance p5 p2) 0.382)) <br />       "c")<br />   (command "-hatch" "p" "solid" A6 "")<br />   (setq n (1+ n)))<br />   (command "layer" "m" "red_flag" "c" "1" """")<br />   (command "-hatch" "p" "solid" (polar (polar B1 0 i1) (/ pi 2) i1) "")<br />   (setvar "osmode" v1)<br />   (setvar "cmdecho" v2)<br />   (setvar "blipmode" v3)<br />   (princ)<br /> )

ferious

yjwht 发表于 2025-3-1 17:26
一直在忙，终于抽出一点时间学习了一下ferious的代码。做一下学习笔记：
1）原来不知道有这个chprop命令 ...

祝你一直进步   会当凌绝顶

linzaijie

又是一个刀迷啊..................

ferious

• 改变 0图层  生成块  欢迎大佬指点提高
• (defun c:wjx (/ v1 v2 v3 S1 ss1 x2 n ) ;绘制红旗
•   (setq v1 (getvar "osmode"))
•   (setq v2 (getvar "cmdecho"))
•   (setq v3 (getvar "blipmode"))
•   (setq BB1 (getpoint "\n 指定红旗一个角点："))
•   (setq BB2 (getpoint BB1 "\n 指定红旗对角角点："))
•   (setq B1 (mapcar 'min BB1 BB2))
•   (setq B2 (mapcar 'max BB1 BB2))
•   (setvar "osmode" 0)
•   (setvar "cmdecho" 0)
•   (setvar "blipmode" 0)
•   (setq i1 (min (/ (- (car B2) (car B1)) 30) (/ (- (cadr B2) (cadr B1)) 20)))
•   (setq B2 (polar (polar B1 0 (* 30 i1)) (/ pi 2) (* 20 i1)))
•   
•   (setq s1 (entlast));最后一个图元的图元名
•   ;(command "layer" "m" "red_flag" "c" "1" """")
•   (command "rectang" B1 B2)
•   (command "CHPROP" (entlast) ""  "LA" "0"   "c" "1"   "")
•   (setq A1 (polar (polar B1 0 (* 5 i1)) (/ pi 2) (* 15 i1)))
•   (setq A2 (polar (polar B1 0 (* 10 i1)) (/ pi 2) (* 18 i1)))
•   (setq A3 (polar (polar B1 0 (* 12 i1)) (/ pi 2) (* 16 i1)))
•   (setq A4 (polar (polar B1 0 (* 12 i1)) (/ pi 2) (* 13 i1)))
•   (setq A5 (polar (polar B1 0 (* 10 i1)) (/ pi 2) (* 11 i1)))
•   ;(command "layer" "m" "yellow_flag" "c" "2" """")
•   (setq  p1 (polar A1 (/ (* (+ (* 0 72) 90) pi) 180) (* 3.333 i1)))
•   (setq  p2 (polar A1 (/ (* (+ (* 1 72) 90) pi) 180) (* 3.333 i1)))
•   (setq  p3 (polar A1 (/ (* (+ (* 2 72) 90) pi) 180) (* 3.333 i1)))
•   (setq  p4 (polar A1 (/ (* (+ (* 3 72) 90) pi) 180) (* 3.333 i1)))
•   (setq  p5 (polar A1 (/ (* (+ (* 4 72) 90) pi) 180) (* 3.333 i1)))
•   (command "pline" p1 (polar p1 (angle p1 p3) (* (distance p1 p3) 0.382))
•     p2 (polar p2 (angle p2 p4) (* (distance p2 p4) 0.382))
•     p3 (polar p3 (angle p3 p5) (* (distance p3 p5) 0.382))
•     p4 (polar p4 (angle p4 p1) (* (distance p4 p1) 0.382))
•     p5 (polar p5 (angle p5 p2) (* (distance p5 p2) 0.382))
•     "c")
•   (command "CHPROP" (entlast) ""  "LA" "0"   "c" "2"   "")
•   (command "-hatch" "p" "solid" A1 "")
•   (command "CHPROP" (entlast) ""  "LA" "0"   "c" "2"   "")
•   (setq n 0)
•   (while (< n 4)
•     (setq A6 (nth n (list A2 A3 A4 A5)))
•     (setq  p1 (polar A6 (+ (/ (* 0 72 pi) 180) (angle A6 A1)) i1))
•     (setq  p2 (polar A6 (+ (/ (* 1 72 pi) 180) (angle A6 A1)) i1))
•     (setq  p3 (polar A6 (+ (/ (* 2 72 pi) 180) (angle A6 A1)) i1))
•     (setq  p4 (polar A6 (+ (/ (* 3 72 pi) 180) (angle A6 A1)) i1))
•     (setq  p5 (polar A6 (+ (/ (* 4 72 pi) 180) (angle A6 A1)) i1))
•     (command "pline" p1 (polar p1 (angle p1 p3) (* (distance p1 p3) 0.382))
•       p2 (polar p2 (angle p2 p4) (* (distance p2 p4) 0.382))
•       p3 (polar p3 (angle p3 p5) (* (distance p3 p5) 0.382))
•       p4 (polar p4 (angle p4 p1) (* (distance p4 p1) 0.382))
•       p5 (polar p5 (angle p5 p2) (* (distance p5 p2) 0.382))
•       "c")
•     (command "-hatch" "p" "solid" A6 "")
•     (command "CHPROP" (entlast) ""  "LA" "0"   "c" "2"   "")
•     (setq n (1+ n)))
•   
•   (command "-hatch" "p" "solid" (polar (polar B1 0 i1) (/ pi 2) i1) "")
•   (command "CHPROP" (entlast) ""  "LA" "0"   "c" "1"   "")
•   
•   (setq ss1 (ssadd))  ;ss1为自S1后生成的图元选择集
•   
•   (while (setq s1 (entnext s1))
•     (ssadd s1 ss1)
•     (princ (sslength ss1))
•   )
•   
•   (setq      x2  (strcat "DGWT-BLK-" (rtos (* (getvar "cdate") 1000000) 2 0)) )
•   (command "_block" x2 BB1 ss1 "")
•   (command "_insert" x2 BB1 "" "" "")
•   
•   (command "CHPROP" (entlast) ""  "LA" "0"     "")
•   
•   (setvar "osmode" v1)
•   (setvar "cmdecho" v2)
•   (setvar "blipmode" v3)
•   (princ)
• )
  

yjwht

@baitang36 目前我还没有权限加好友
感谢大家，我会继续努力，多发好作品！

煮茗

同样喜欢玩的路过。
这是我以前用dynamo做的。

qazxswk

不错，支持一下。

loveu515

不错，支持一下

2369198685

虽然用不到，不得不赞

寒潮大冬瓜

很好→很棒！很好~很棒！！很好……很棒！！！

liweitung

四个小星星大小不一。

newmooooon

很好玩的一个程序

阿猪蛋

不错，支持一下。

yjwht

liweitung 发表于 2025-2-24 08:46
四个小星星大小不一。

大小相同，是角度不一