|
|
用了deepseek寫的VBA代碼用在CAD，挺好用的。有沒有其他的方便CAD使用的deepseek的例子推薦一下？ * l/ |" V5 @& b# @' h
- Sub AddRectangleAndArrayAndTrim()
9 p/ {* I. ]" l8 c* e0 I: t - ' 聲明變量* I3 B) ^ R4 j8 n. v `
- Dim lineObj As Object
9 U7 {0 w9 M* S& P7 F# J" s% I - Dim startPoint As Variant3 a) |# I' \' x1 d
- Dim endPoint As Variant
" h7 E% |/ {. d0 R: R) W - Dim rectWidth As Double5 Y6 p7 m% b* L q; R# F- J' i
- Dim rectHeight As Double+ ]) h6 K/ n$ T" t. V
- Dim rectStartPoint(0 To 2) As Double# M+ f! Z5 A, f Z7 e
- Dim rectEndPoint(0 To 2) As Double* C2 o$ A' ]3 `
- Dim rotationAngle As Double* f0 y+ E& z9 E3 C+ _; s& T
- Dim rectObj As Object
# G$ A y, A5 l& b$ u3 C9 X - Dim points(0 To 7) As Double ' 用于存儲矩形的四個頂點" b1 m2 s, b9 s# ~1 J# I
- Dim centerPoint(0 To 2) As Double ' 直線的中點6 m6 e5 y9 Z! Z/ h
- Dim newRectObj As Object ' 復制的矩形對象# p; B/ l+ [& [, B
- Dim rotationAngleRad As Double ' 旋轉角度（弧度）/ m# i1 N$ O4 T$ j
- Dim intersectPoint As Variant ' 交點
- Z0 p* _" ?$ A# J9 m; v2 m - Dim trimStartPoint As Variant ' 修剪后的起點
& Z9 E Y( s; w4 | - Dim trimEndPoint As Variant ' 修剪后的終點; {/ S4 X C1 y
-
m( w* G- B( }0 l/ [5 l - ' 定義矩形的尺寸2 u$ H6 V" d. k7 i z/ x3 A0 c/ K$ K
- rectWidth = 0.1 ' 矩形的寬度（短邊）
" Z5 V1 _& U$ b - rectHeight = 1 ' 矩形的高度（長邊）: I& k" E4 \# a2 I
-
! V+ Z; p8 k" j% T9 x - ' 提示用戶選擇一條直線
, P `# e# u) p6 [2 S, l. Y - On Error Resume Next
: ^( ]8 T! Q* `3 l5 A0 z/ { - ThisDrawing.Utility.GetEntity lineObj, startPoint, "請選擇一條直線: "
0 y' T% [8 v% P/ J - On Error GoTo 0
. l* H; t# i( {( ~( M+ W -
o o, O6 \* y! Q3 g - ' 檢查用戶是否選擇了直線6 s, N" d7 ]/ s! n' s& _' f
- If lineObj Is Nothing Then6 ?; V$ d. o& z8 n, r: z b
- MsgBox "未選擇直線或選擇無效。"9 u2 ^$ B6 c) w
- Exit Sub
! @& o0 U6 [# p2 } - End If
$ F2 M. M2 }2 X2 P5 S/ I+ t -
/ M! I. z {- W - ' 獲取直線的起點和終點. d( J! I. {! G' A* e: \
- startPoint = lineObj.StartPoint1 z; R+ L5 C4 G+ j- y
- endPoint = lineObj.EndPoint' x+ P+ W0 F; a: j8 b8 j0 W
-
) i! e( ]+ H9 W6 H - ' 計算直線的中點
& j; T0 |. ^5 @- e: X - centerPoint(0) = (startPoint(0) + endPoint(0)) / 20 L2 `) d8 Q0 y
- centerPoint(1) = (startPoint(1) + endPoint(1)) / 27 _" q4 c( f# z. |
- centerPoint(2) = (startPoint(2) + endPoint(2)) / 2
1 q Y8 N6 V2 s* L B- g% C - ( B# F( G8 z$ V" t* c7 \
- ' 計算直線的角度（用于矩形的旋轉）9 c8 Y) |0 _$ f2 g% ~0 ]' I
- rotationAngle = Atn((endPoint(1) - startPoint(1)) / (endPoint(0) - startPoint(0)))
5 F8 H$ J' d- N) a e -
# e# w6 H, k" Z$ y9 V9 U2 B - ' 計算矩形的起點和終點
1 ^7 U7 I8 ~' W0 Y. H P$ N( o8 o- P - rectStartPoint(0) = startPoint(0) - (rectWidth / 2) * Cos(rotationAngle + (3.14159 / 2))
) |; k' R4 X( [( K0 q! o - rectStartPoint(1) = startPoint(1) - (rectWidth / 2) * Sin(rotationAngle + (3.14159 / 2))8 A' r5 _& ?& p, A' z6 [) Y4 s* ~
- rectStartPoint(2) = startPoint(2)) ?* u6 b/ _3 I. {
- : |; Y6 j$ v' q" T! ^8 k4 J3 Z
- rectEndPoint(0) = rectStartPoint(0) + rectHeight * Cos(rotationAngle)6 r4 A$ s) I% V1 }5 C; Y
- rectEndPoint(1) = rectStartPoint(1) + rectHeight * Sin(rotationAngle): w# z; z% [) [/ o' y$ G1 r
- rectEndPoint(2) = rectStartPoint(2)2 A+ R9 A) S" O4 j% C# X
-
; {3 u+ K M E# j - ' 定義矩形的四個頂點% t* z* B0 p5 J
- points(0) = rectStartPoint(0)4 ?0 p0 S9 ?, _5 w, a! W$ U, T
- points(1) = rectStartPoint(1)" }- v( m4 i% u# U+ x9 G8 R* |6 t
- points(2) = rectEndPoint(0)* Z' u, a% M& m! z G6 ]" X* l
- points(3) = rectEndPoint(1)6 F/ V5 d2 R. c3 Q% v& n9 h
- points(4) = rectEndPoint(0) + rectWidth * Cos(rotationAngle + (3.14159 / 2))$ G8 d# U" K3 W* V
- points(5) = rectEndPoint(1) + rectWidth * Sin(rotationAngle + (3.14159 / 2))" E% \) k5 G$ g
- points(6) = rectStartPoint(0) + rectWidth * Cos(rotationAngle + (3.14159 / 2))
% Y. |2 P+ ^0 I- U - points(7) = rectStartPoint(1) + rectWidth * Sin(rotationAngle + (3.14159 / 2))4 ~- c" |0 ?# f5 C5 `* g
- 0 \7 o( l* m, K0 L
- ' 創建矩形+ w, r; P. C& c2 L& ]) F$ y/ Z
- Set rectObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
/ H8 _+ {+ Q* G - . N0 ?2 k2 o, F! f8 k
- ' 創建圓周陣列（手動復制和旋轉）
! p) k/ |. _% d8 Y* e% D - rotationAngleRad = 180 * (3.14159 / 180) ' 將角度轉換為弧度
7 `! v D/ O4 s1 a" r - Set newRectObj = rectObj.Copy/ e/ y: G* F. M& [* e k
- newRectObj.Rotate centerPoint, rotationAngleRad4 |- K; K" E# Z5 a9 Z$ S5 U- T
- $ |2 f4 ^ K1 _) I L& f$ B" H+ k
- ' 修剪直線
$ g' x: c! A! z( `; T$ p8 T$ ^8 Y - ' 查找直線與矩形的交點
4 `3 t5 b' y. a - intersectPoint = lineObj.IntersectWith(rectObj, acExtendNone)9 I" H; u- ?3 a9 f
- If Not IsEmpty(intersectPoint) Then
( d/ N" g, b6 V9 b - ' 修剪直線的起點# J+ y: T2 ]; Q% i9 \; f
- trimStartPoint = intersectPoint! h7 ?5 i, W0 ~: s- ^2 f0 \+ Y
- lineObj.StartPoint = trimStartPoint/ @+ G+ r) T+ p G" Q; ]: O
- End If, s7 `0 k8 S, k2 @/ F2 i
- ; A% k' J- U0 R1 a
- intersectPoint = lineObj.IntersectWith(newRectObj, acExtendNone)
4 A2 e A; i1 ^- m - If Not IsEmpty(intersectPoint) Then
$ M( Z+ x- @; Y( z - ' 修剪直線的終點( Q5 G+ e3 m6 q4 l
- trimEndPoint = intersectPoint
% R$ l$ c( T3 K% l8 \- ? ~ - lineObj.EndPoint = trimEndPoint
% X' d" ?) g2 E" i1 x" K9 i- C - End If& q# U; i* b( G8 |/ k' b7 p
- / l1 h" D- S" O
- ' 刷新視圖( B$ ]& R6 U, q6 L/ H: ]
- ThisDrawing.Regen True2 C' J8 j8 p3 E8 }2 H/ g
-
/ m/ a/ t5 H, O6 p2 ~ - ' 提示用戶
3 A; u1 o$ O& u/ ]0 W - MsgBox "矩形、陣列和修剪操作已完成！"
; a3 G# X+ Y) k - End Sub
]( |* V6 B7 T3 m n1 y2 R8 S$ L( q
|
|
發表于 2025-2-7 09:55:16
QQ好友和群
QQ空間
