📄 dxfortranstd.f90
字号:
!- End of header ---------------------------------------------------------------
write (FileNum,fmt='(A)') " 0" !+ Begin of ARC
write (FileNum,fmt='(A)') "ARC" !
write (FileNum,fmt='(A)') " 8" !+ Layer code
write (FileNum,fmt='(A)') TRIM(Layer) !+ Layer's name
if (Color=="bylayer" .or. &
Color=="Bylayer" .or. &
Color=="BYLAYER") then
! Nothing to do if color is bylayer
else
write (FileNum,fmt='(A)') " 62" !+ Color code
write (FileNum,fmt='(A)') TRIM(Color) !
end if
write (FileNum,fmt='(A)') " 39" !+ Thickness of the ARC (3D)
write (FileNum,fmt= * ) Thick !
write (FileNum,fmt='(A)') " 10" !+ Point codes
write (FileNum,fmt= * ) X !
write (FileNum,fmt='(A)') " 20" !
write (FileNum,fmt= * ) Y !
write (FileNum,fmt='(A)') " 30" !
write (FileNum,fmt= * ) Z !
write (FileNum,fmt='(A)') " 40" !
write (FileNum,fmt= * ) Radius !+ Radius of the Arc
write (FileNum,fmt='(A)') " 50" !
write (FileNum,fmt= * ) SAngle !+ Start Angle
write (FileNum,fmt='(A)') " 51" !
write (FileNum,fmt= * ) EAngle !+ End Angle
return
end subroutine dfArc
!
!Draw a circle with a center point and a radius
!
subroutine dfCircle &
(FileNum, &
Layer, &
Color, &
X, &
Y, &
Z, &
Radius, &
Thick)
!
! Description:
!
! Draw a circle in the in the file <FileNum> in the layer <Layer>
! and in the color <Color> with coordenates (X,Y,Z) and radius <Radius>
!
!
! Method:
! No comment...
!
! Current Code Owner:
! David A. B.Pereira
! (Department of Civil Engineering of the University of Algarve - Portugal)
! www.ualg.pt/est/adec/csc/dxfortran
!
! History:
! Version Date Comment
! ------- -------- -------
! 02.01.29 David A. B. Pereira
! 04.02.23 Davide Santos
!
!
! Code Description:
! Language: Fortran 90.
! Software Standards: "European Standards for Writing and
! Documenting Exchangeable Fortran 90 Code".
!
Implicit None
! Include statements:
! Declarations must be of the form:
! Subroutine arguments
! Scalar arguments with intent(in):
Real, Intent (in) :: &
X, & !+ Coordenate XX
Y, & !+ Coordenate YY
Z, & !+ Coordenate ZZ
Radius, & !+ Radius of the circle
Thick !+ Thickness
Integer ,Intent (in) :: FileNum !+ File number
Character , Intent(in) :: &
Color *(*), & !+ Circle Color
Layer *(*) !+ Circle Layer
!- End of header ---------------------------------------------------------------
write (FileNum,fmt='(A)') " 0" !+ Begin of Circle
write (FileNum,fmt='(A)') "CIRCLE" !
write (FileNum,fmt='(A)') " 8" !+ Layer code
write (FileNum,fmt='(A)') TRIM(Layer) !+ Layer's name
if (Color=="bylayer" .or. &
Color=="Bylayer" .or. &
Color=="BYLAYER") then
! Nothing to do if color is bylayer
else
write (FileNum,fmt='(A)') " 62" !+ Color code
write (FileNum,fmt='(A)') TRIM(Color) !
end if
write (FileNum,fmt='(A)') " 39" !+ Thickness of the circle (3D)
write (FileNum,fmt= * ) Thick !
write (FileNum,fmt='(A)') " 10" !+ Point codes
write (FileNum,fmt= * ) X !
write (FileNum,fmt='(A)') " 20" !
write (FileNum,fmt= * ) Y !
write (FileNum,fmt='(A)') " 30" !
write (FileNum,fmt= * ) Z !
write (FileNum,fmt='(A)') " 40" !
write (FileNum,fmt= * ) Radius !+ Radius of the circle
return
end subroutine dfCircle
!
! Draw a DONUT in DXF format.
!
Subroutine dfDonut(FileNum, LayerName, Color,Dint, Dext, X, Y)
!
! Description:
!
! To draw a DONUT in the in DXF with coordenates <X>, <Y> and
! with inside diameter <DINT> and the outside diameter <DEXT>
!
! Input variables:
! the file number <FILENUM>
! the file name <FILENAME>
! the layer name <LAYERNAME>
! the inside diameter <DINT>
! the outside diameter <DEXT>
! the coordenates of the center of the donut <X> and <Y>
! Method:
! No comment...
!
! Current Code Owner:
! David A. B. Pereira
! (Department of Civil Engineering of the University of Algarve - Portugal)
!
! History:
! Version Date Comment
! ------- -------- -------
! 02.04.12 David A. B. Pereira
!
!
! Code Description:
! Language: Fortran 90.
! Software Standards: "European Standards for Writing and
! Documenting Exchangeable Fortran 90 Code".
!
Implicit None
CHARACTER, INTENT(IN) :: LayerName *(*),Color*(*)
INTEGER, INTENT(IN) :: FileNum
REAL,INTENT(IN) :: DINT, Dext, X, Y
write (FileNum,fmt='(A)') " 0"
write (FileNum,fmt='(A)') "POLYLINE"
write (FileNum,fmt='(A)') " 8"
write (FileNum,fmt='(A)') TRIM(LAYERNAME)
if (COLOR=="bylayer" .or. &
COLOR=="Bylayer" .or. &
COLOR=="BYLAYER") then
! Nothing to do if color is bylayer
else
write (FileNum,fmt='(A)') " 62" !+ Color code
write (FileNum,fmt='(A)') TRIM(COLOR) !
end if
write (FileNum,fmt='(A)') " 66"
write (FileNum,fmt='(A)') " 1"
write (FileNum,fmt='(A)') " 10"
write (FileNum,fmt='(F10.6)') DINT
write (FileNum,fmt='(A)') " 20"
write (FileNum,fmt='(F10.6)') DINT
write (FileNum,fmt='(A)') " 30"
write (FileNum,fmt='(F10.6)') 0.0
write (FileNum,fmt='(A)') " 70"
write (FileNum,fmt='(A)') " 1"
write (FileNum,fmt='(A)') " 40"
write (FileNum,fmt='(F10.6)') 0.50*DEXT
write (FileNum,fmt='(A)') " 41"
write (FileNum,fmt='(F10.6)') 0.5*DEXT
write (FileNum,fmt='(A)') " 0"
write (FileNum,fmt='(A)') "VERTEX"
write (FileNum,fmt='(A)') " 8"
write (FileNum,fmt='(A)') TRIM(LAYERNAME)
if (COLOR=="bylayer" .or. &
COLOR=="Bylayer" .or. &
COLOR=="BYLAYER") then
! Nothing to do if color is bylayer
else
write (FileNum,fmt='(A)') " 62" !+ Color code
write (FileNum,fmt='(A)') TRIM(COLOR) !
end if
write (FileNum,fmt='(A)') " 10"
write (FileNum,fmt='(F10.6)') X-0.25*DEXT
write (FileNum,fmt='(A)') " 20"
write (FileNum,fmt='(F10.6)') Y
write (FileNum,fmt='(A)') " 30"
write (FileNum,fmt='(F10.6)') 0.0
write (FileNum,fmt='(A)') " 42"
write (FileNum,fmt='(A)') " 1.0"
write (FileNum,fmt='(A)') " 0"
write (FileNum,fmt='(A)') "VERTEX"
write (FileNum,fmt='(A)') " 8"
write (FileNum,fmt='(A)') TRIM(LAYERNAME)
if (COLOR=="bylayer" .or. &
COLOR=="Bylayer" .or. &
COLOR=="BYLAYER") then
! Nothing to do if color is bylayer
else
write (FileNum,fmt='(A)') " 62" !+ Color code
write (FileNum,fmt='(A)') TRIM(COLOR) !
end if
write (FileNum,fmt='(A)') " 10"
write (FileNum,fmt='(F10.6)') X+0.25*DEXT
write (FileNum,fmt='(A)') " 20"
write (FileNum,fmt='(F10.6)') Y
write (FileNum,fmt='(A)') " 30"
write (FileNum,fmt='(F10.6)') 0.0
write (FileNum,fmt='(A)') " 42"
write (FileNum,fmt='(A)') " 1.0"
write (FileNum,fmt='(A)') " 0"
write (FileNum,fmt='(A)') "SEQEND"
write (FileNum,fmt='(A)') " 8"
write (FileNum,fmt='(A)') TRIM(LAYERNAME)
if (COLOR=="bylayer" .or. &
COLOR=="Bylayer" .or. &
COLOR=="BYLAYER") then
! Nothing to do if color is bylayer
else
write (FileNum,fmt='(A)') " 62" !+ Color code
write (FileNum,fmt='(A)') TRIM(COLOR) !
end if
RETURN
!
! The End of DONUT Subroutine
!
End Subroutine dfDonut
!
!
!+ Draw a line in DXF format.
!
Subroutine dfLine &
(FileNum, &
Layer, &
Ltype, &
Color, &
X1, &
Y1, &
Z1, &
X2, &
Y2, &
Z2, &
Thick)
! Description:
! Draw a line in the in the file <FileNum> in the layer <Layer>
! and in the color <Color> with coordenates of 1st note (X1, Y1),
! and the 2nd node coordenate (X2, Y2) and with the height <Thick>
!
! Method:
! No comment...
!
! Current Code Owner:
! Carlos Otero & Davide Santos
! (Department of Civil Engineering of the University of Algarve - Portugal)
!
! History:
! Version Date Comment
! ------- ----- -------
! 0.1 00.11 Carlos Otero & Davide Santos
! 0.2 00.12 Carlos Otero & Davide Santos
! 0.3 02.02 David A. B. Pereira
!
! Code Description:
! Language: Fortran 90.
! Software Standards: "European Standards for Writing and
! Documenting Exchangeable Fortran 90 Code".
!
Implicit None
! Include statements:
! Declarations must be of the form:
! Subroutine arguments
! Scalar arguments with intent(in):
Real,Intent (in) :: &
X1, & !+ Coordenate XX of the 1st node
Y1, & !+ Coordenate YY of the 1st node
Z1, & !+ Coordenate ZZ of the 1st node
X2, & !+ Coordenate XX of the 2nd node
Y2, & !+ Coordenate YY of the 2nd node
Z2, & !+ Coordenate ZZ of the 1st node
Thick !+ THICKNESS
Integer ,Intent (in) :: FileNum !+ File number
Character , Intent(in) :: &
Color *(*), & !+ Line's Color
Layer *(*), & !+ Line's layer
Ltype *(*) !+ Line's "LineType"
!- End of header ---------------------------------------------------------------
write (FileNum,fmt='(A)') " 0" !+ Begin of line
write (FileNum,fmt='(A)') "LINE" !
write (FileNum,fmt='(A)') " 8" !+ Layer code
write (FileNum,fmt='(A)') TRIM(Layer) !+ Layer's name
write (FileNum,fmt='(A)') " 6" !
write (FileNum,fmt='(A)') TRIM(Ltype) !
if (Color=="bylayer" .or. Color=="Bylayer" .or. Color=="BYLAYER") then
else
write (FileNum,fmt='(A)') " 62" !+ Color code
write (FileNum,fmt='(A)') TRIM(Color) !
end if
write (FileNum,fmt='(A)') " 39" !+ THICKNESS OF THE LINE (3D)
write (FileNum,fmt= * ) Thick !
write (FileNum,fmt='(A)') " 10" !+ Begin of line coordenate X1
write (FileNum,fmt= * ) X1 !
write (FileNum,fmt='(A)') " 20" !+ Begin of line coordenate Y1
write (FileNum,fmt= * ) Y1 !
write (FileNum,fmt='(A)') " 30" !+ Begin of line coordenate Z1
write (FileNum,fmt= * ) Z1 !
write (FileNum,fmt='(A)') " 11" !+ End of line coordenate Y2
write (FileNum,fmt= * ) X2 !
write (FileNum,fmt='(A)') " 21" !+ End of line coordenate Y2
write (FileNum,fmt= * ) Y2 !
write (FileNum,fmt='(A)') " 31" !+ End of line coordenate Z2
write (FileNum,fmt= * ) Z2 !
return
end subroutine dfLine
!
!+ Begin of a polyline
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -